    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards #-}
    {- |
       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.Except (throwError, catchError)
    import Control.Monad.Reader
    import Control.Monad.State
    import Codec.Archive.Zip
    import Data.Char (toUpper)
    import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf, intersperse)
    import Data.Default
    import qualified Data.Text as T
    import Data.Time (formatTime, defaultTimeLocale)
    import Data.Time.Clock (UTCTime)
    import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
    import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension)
    import Text.XML.Light
    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.Options
    import Text.Pandoc.MIME
    import qualified Data.ByteString.Lazy as BL
    import Text.Pandoc.Writers.OOXML
    import qualified Data.Map as M
    import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes, isJust)
    import Text.Pandoc.ImageSize
    import Control.Applicative ((<|>))
    import System.FilePath.Glob
    import Text.DocTemplates (FromContext(lookupContext))
    import Text.TeXMath
    import Text.Pandoc.Writers.Math (convertMath)
    import Text.Pandoc.Writers.Powerpoint.Presentation
    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 :: Pixels -> Pixels
    pixelsToEmu = (12700 Pixels -> Pixels -> Pixels
    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 refArchive :: Archive
    refArchive distArchive :: 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 "ppt/media/image") [FilePath]
    archiveFiles

          go :: FilePath -> Maybe (FilePath, Int)
          go :: FilePath -> Maybe (FilePath, Int)
    go fp :: FilePath
    fp = do
            FilePath
    s <- FilePath -> FilePath -> Maybe FilePath
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix "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 :: Int
    n, _) <- [(Int, FilePath)] -> Maybe (Int, FilePath)
    forall a. [a] -> Maybe a
    listToMaybe ([(Int, FilePath)] -> Maybe (Int, FilePath))
    -> [(Int, FilePath)] -> Maybe (Int, FilePath)
    forall a b. (a -> b) -> a -> b
    $ ReadS Int
    forall a. Read a => ReadS a
    reads FilePath
    s
            (FilePath, Int) -> Maybe (FilePath, Int)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FilePath
    fp, Int
    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 (Pixels, Pixels)
    getPresentationSize refArchive :: Archive
    refArchive distArchive :: Archive
    distArchive = do
      Entry
    entry <- FilePath -> Archive -> Maybe Entry
    findEntryByPath "ppt/presentation.xml" Archive
    refArchive  Maybe Entry -> Maybe Entry -> Maybe Entry
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
               FilePath -> Archive -> Maybe Entry
    findEntryByPath "ppt/presentation.xml" Archive
    distArchive
      Element
    presElement <- FilePath -> Maybe Element
    forall s. XmlSource s => s -> Maybe Element
    parseXMLDoc (FilePath -> Maybe Element) -> FilePath -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $ ByteString -> FilePath
    UTF8.toStringLazy (ByteString -> FilePath) -> ByteString -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Entry -> ByteString
    fromEntry Entry
    entry
      let ns :: NameSpaces
    ns = Element -> NameSpaces
    elemToNameSpaces Element
    presElement
      Element
    sldSize <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "sldSz") Element
    presElement
      FilePath
    cxS <- QName -> Element -> Maybe FilePath
    findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "cx" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    sldSize
      FilePath
    cyS <- QName -> Element -> Maybe FilePath
    findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "cy" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    sldSize
      (cx :: Pixels
    cx, _) <- [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a. [a] -> Maybe a
    listToMaybe ([(Pixels, FilePath)] -> Maybe (Pixels, FilePath))
    -> [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a b. (a -> b) -> a -> b
    $ ReadS Pixels
    forall a. Read a => ReadS a
    reads FilePath
    cxS :: Maybe (Integer, String)
      (cy :: Pixels
    cy, _) <- [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a. [a] -> Maybe a
    listToMaybe ([(Pixels, FilePath)] -> Maybe (Pixels, FilePath))
    -> [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a b. (a -> b) -> a -> b
    $ ReadS Pixels
    forall a. Read a => ReadS a
    reads FilePath
    cyS :: Maybe (Integer, String)
      (Pixels, Pixels) -> Maybe (Pixels, Pixels)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pixels
    cx Pixels -> Pixels -> Pixels
    forall a. Integral a => a -> a -> a
    `div` 12700, Pixels
    cy Pixels -> Pixels -> Pixels
    forall a. Integral a => a -> a -> a
    `div` 12700)

    data WriterEnv = WriterEnv { WriterEnv -> Archive
    envRefArchive :: Archive
                               , WriterEnv -> Archive
    envDistArchive :: Archive
                               , WriterEnv -> UTCTime
    envUTCTime :: UTCTime
                               , WriterEnv -> WriterOptions
    envOpts :: WriterOptions
                               , WriterEnv -> (Pixels, Pixels)
    envPresentationSize :: (Integer, Integer)
                               , WriterEnv -> Bool
    envSlideHasHeader :: Bool
                               , WriterEnv -> Bool
    envInList :: Bool
                               , WriterEnv -> Bool
    envInNoteSlide :: Bool
                               , WriterEnv -> Int
    envCurSlideId :: Int
                               -- the difference between the number at
                               -- the end of the slide file name and
                               -- the rId number
                               , WriterEnv -> Int
    envSlideIdOffset :: Int
                               , WriterEnv -> ContentType
    envContentType :: ContentType
                               , 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
                               }
                     deriving (Int -> WriterEnv -> ShowS
    [WriterEnv] -> ShowS
    WriterEnv -> FilePath
    (Int -> WriterEnv -> ShowS)
    -> (WriterEnv -> FilePath)
    -> ([WriterEnv] -> ShowS)
    -> Show WriterEnv
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    showList :: [WriterEnv] -> ShowS
    $cshowList :: [WriterEnv] -> ShowS
    show :: WriterEnv -> FilePath
    $cshow :: WriterEnv -> FilePath
    showsPrec :: Int -> WriterEnv -> ShowS
    $cshowsPrec :: Int -> WriterEnv -> ShowS
    Show)

    instance Default WriterEnv where
      def :: WriterEnv
    def = WriterEnv :: Archive
    -> Archive
    -> UTCTime
    -> WriterOptions
    -> (Pixels, Pixels)
    -> Bool
    -> Bool
    -> Bool
    -> Int
    -> Int
    -> ContentType
    -> Map SlideId Int
    -> Map Int Int
    -> WriterEnv
    WriterEnv { envRefArchive :: Archive
    envRefArchive = Archive
    emptyArchive
                      , envDistArchive :: Archive
    envDistArchive = Archive
    emptyArchive
                      , envUTCTime :: UTCTime
    envUTCTime = POSIXTime -> UTCTime
    posixSecondsToUTCTime 0
                      , envOpts :: WriterOptions
    envOpts = WriterOptions
    forall a. Default a => a
    def
                      , envPresentationSize :: (Pixels, Pixels)
    envPresentationSize = (720, 540)
                      , envSlideHasHeader :: Bool
    envSlideHasHeader = Bool
    False
                      , envInList :: Bool
    envInList = Bool
    False
                      , envInNoteSlide :: Bool
    envInNoteSlide = Bool
    False
                      , envCurSlideId :: Int
    envCurSlideId = 1
                      , envSlideIdOffset :: Int
    envSlideIdOffset = 1
                      , envContentType :: ContentType
    envContentType = ContentType
    NormalContent
                      , 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
                      }

    data ContentType = NormalContent
                     | TwoColumnLeftContent
                     | TwoColumnRightContent
                     deriving (Int -> ContentType -> ShowS
    [ContentType] -> ShowS
    ContentType -> FilePath
    (Int -> ContentType -> ShowS)
    -> (ContentType -> FilePath)
    -> ([ContentType] -> ShowS)
    -> Show ContentType
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    showList :: [ContentType] -> ShowS
    $cshowList :: [ContentType] -> ShowS
    show :: ContentType -> FilePath
    $cshow :: ContentType -> FilePath
    showsPrec :: Int -> ContentType -> ShowS
    $cshowsPrec :: Int -> ContentType -> ShowS
    Show, ContentType -> ContentType -> Bool
    (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> Bool) -> Eq ContentType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: ContentType -> ContentType -> Bool
    $c/= :: ContentType -> ContentType -> Bool
    == :: ContentType -> ContentType -> Bool
    $c== :: ContentType -> ContentType -> Bool
    Eq)

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

    instance Default WriterState where
      def :: WriterState
    def = WriterState :: Map Int (Map Int LinkTarget)
    -> Map Int [MediaInfo] -> Map FilePath Int -> WriterState
    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
                        }

    type P m = ReaderT WriterEnv (StateT WriterState m)

    runP :: Monad m => WriterEnv -> WriterState -> P m a -> m a
    runP :: WriterEnv -> WriterState -> P m a -> m a
    runP env :: WriterEnv
    env st :: WriterState
    st p :: 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

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

    findAttrText :: QName -> Element -> Maybe T.Text
    findAttrText :: QName -> Element -> Maybe MimeType
    findAttrText n :: QName
    n = (FilePath -> MimeType) -> Maybe FilePath -> Maybe MimeType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> MimeType
    T.pack (Maybe FilePath -> Maybe MimeType)
    -> (Element -> Maybe FilePath) -> Element -> Maybe MimeType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Element -> Maybe FilePath
    findAttr QName
    n

    monospaceFont :: Monad m => P m T.Text
    monospaceFont :: P m MimeType
    monospaceFont = do
      Context MimeType
    vars <- WriterOptions -> Context MimeType
    writerVariables (WriterOptions -> Context MimeType)
    -> ReaderT WriterEnv (StateT WriterState m) WriterOptions
    -> ReaderT WriterEnv (StateT WriterState m) (Context MimeType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (WriterEnv -> WriterOptions)
    -> ReaderT WriterEnv (StateT WriterState m) WriterOptions
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> WriterOptions
    envOpts
      case MimeType -> Context MimeType -> Maybe MimeType
    forall a b. FromContext a b => MimeType -> Context a -> Maybe b
    lookupContext "monofont" Context MimeType
    vars of
        Just s :: MimeType
    s -> MimeType -> P m MimeType
    forall (m :: * -> *) a. Monad m => a -> m a
    return MimeType
    s
        Nothing -> MimeType -> P m MimeType
    forall (m :: * -> *) a. Monad m => a -> m a
    return "Courier"

    -- Kept as string for XML.Light
    fontSizeAttributes :: Monad m => RunProps -> P m [(String, String)]
    fontSizeAttributes :: RunProps -> P m NameSpaces
    fontSizeAttributes RunProps { rPropForceSize :: RunProps -> Maybe Pixels
    rPropForceSize = Just sz :: Pixels
    sz } =
      NameSpaces -> P m NameSpaces
    forall (m :: * -> *) a. Monad m => a -> m a
    return [("sz", Pixels -> FilePath
    forall a. Show a => a -> FilePath
    show (Pixels -> FilePath) -> Pixels -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Pixels
    sz Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * 100)]
    fontSizeAttributes _ = NameSpaces -> P m NameSpaces
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    copyFileToArchive :: PandocMonad m => Archive -> FilePath -> P m Archive
    copyFileToArchive :: Archive -> FilePath -> P m Archive
    copyFileToArchive arch :: Archive
    arch fp :: FilePath
    fp = do
      Archive
    refArchive <- (WriterEnv -> Archive) -> P m Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      Archive
    distArchive <- (WriterEnv -> Archive) -> P m Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envDistArchive
      case FilePath -> Archive -> Maybe Entry
    findEntryByPath FilePath
    fp Archive
    refArchive Maybe Entry -> Maybe Entry -> Maybe Entry
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` FilePath -> Archive -> Maybe Entry
    findEntryByPath FilePath
    fp Archive
    distArchive of
        Nothing -> PandocError -> P m Archive
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> P m Archive) -> PandocError -> P m Archive
    forall a b. (a -> b) -> a -> b
    $ MimeType -> PandocError
    PandocSomeError
                              (MimeType -> PandocError) -> MimeType -> PandocError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> MimeType
    T.pack
                              (FilePath -> MimeType) -> FilePath -> MimeType
    forall a b. (a -> b) -> a -> b
    $ FilePath
    fp FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> " missing in reference file"
        Just e :: Entry
    e -> Archive -> P m Archive
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Archive -> P m Archive) -> Archive -> P 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 [ "docProps/app.xml"
                  , "ppt/slideLayouts/slideLayout*.xml"
                  , "ppt/slideLayouts/_rels/slideLayout*.xml.rels"
                  , "ppt/slideMasters/slideMaster1.xml"
                  , "ppt/slideMasters/_rels/slideMaster1.xml.rels"
                  , "ppt/theme/theme1.xml"
                  , "ppt/theme/_rels/theme1.xml.rels"
                  , "ppt/presProps.xml"
                  , "ppt/tableStyles.xml"
                  , "ppt/media/image*"
                  ]

    -- We only look for these under special conditions
    contingentInheritedPatterns :: Presentation -> [Pattern]
    contingentInheritedPatterns :: Presentation -> [Pattern]
    contingentInheritedPatterns pres :: 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 [ "ppt/notesMasters/notesMaster*.xml"
                       , "ppt/notesMasters/_rels/notesMaster*.xml.rels"
                       , "ppt/theme/theme2.xml"
                       , "ppt/theme/_rels/theme2.xml.rels"
                       ]
      else []

    inheritedPatterns :: Presentation -> [Pattern]
    inheritedPatterns :: Presentation -> [Pattern]
    inheritedPatterns pres :: 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 :: Pattern -> P m [FilePath]
    patternToFilePaths pat :: Pattern
    pat = do
      Archive
    refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      Archive
    distArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envDistArchive

      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
      [FilePath] -> P m [FilePath]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([FilePath] -> P m [FilePath]) -> [FilePath] -> P m [FilePath]
    forall a b. (a -> b) -> a -> b
    $ (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Pattern -> FilePath -> Bool
    match Pattern
    pat) [FilePath]
    archiveFiles

    patternsToFilePaths :: PandocMonad m => [Pattern] -> P m [FilePath]
    patternsToFilePaths :: [Pattern] -> P m [FilePath]
    patternsToFilePaths pats :: [Pattern]
    pats = [[FilePath]] -> [FilePath]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[FilePath]] -> [FilePath])
    -> ReaderT WriterEnv (StateT WriterState m) [[FilePath]]
    -> P m [FilePath]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Pattern -> P 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)
    mapM Pattern -> P 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 = [ "docProps/app.xml"
                    , "ppt/presProps.xml"
                    , "ppt/slideLayouts/slideLayout1.xml"
                    , "ppt/slideLayouts/_rels/slideLayout1.xml.rels"
                    , "ppt/slideLayouts/slideLayout2.xml"
                    , "ppt/slideLayouts/_rels/slideLayout2.xml.rels"
                    , "ppt/slideLayouts/slideLayout3.xml"
                    , "ppt/slideLayouts/_rels/slideLayout3.xml.rels"
                    , "ppt/slideLayouts/slideLayout4.xml"
                    , "ppt/slideLayouts/_rels/slideLayout4.xml.rels"
                    , "ppt/slideMasters/slideMaster1.xml"
                    , "ppt/slideMasters/_rels/slideMaster1.xml.rels"
                    , "ppt/theme/theme1.xml"
                    , "ppt/tableStyles.xml"
                    ]

    presentationToArchiveP :: PandocMonad m => Presentation -> P m Archive
    presentationToArchiveP :: Presentation -> P m Archive
    presentationToArchiveP p :: Presentation
    p@(Presentation docProps :: DocProps
    docProps slides :: [Slide]
    slides) = do
      [FilePath]
    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]
    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
      Bool
    -> ReaderT WriterEnv (StateT WriterState m) ()
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    missingFiles)
        (PandocError -> ReaderT WriterEnv (StateT WriterState m) ()
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> ReaderT WriterEnv (StateT WriterState m) ())
    -> PandocError -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $
          MimeType -> PandocError
    PandocSomeError (MimeType -> PandocError) -> MimeType -> PandocError
    forall a b. (a -> b) -> a -> b
    $
          "The following required files are missing:\n" MimeType -> MimeType -> MimeType
    forall a. Semigroup a => a -> a -> a
    <>
          [MimeType] -> MimeType
    T.unlines ((FilePath -> MimeType) -> [FilePath] -> [MimeType]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> MimeType
    T.pack (FilePath -> MimeType) -> ShowS -> FilePath -> MimeType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ("  " FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>)) [FilePath]
    missingFiles)
        )

      Archive
    newArch' <- (Archive -> FilePath -> P m Archive)
    -> Archive -> [FilePath] -> P m Archive
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Archive -> FilePath -> P m Archive
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> FilePath -> P m Archive
    copyFileToArchive Archive
    emptyArchive [FilePath]
    filePaths
      -- we make a modified ppt/viewProps.xml out of the presentation viewProps
      Entry
    viewPropsEntry <- P m Entry
    forall (m :: * -> *). PandocMonad m => P m Entry
    makeViewPropsEntry
      -- we make a docProps/core.xml entry out of the presentation docprops
      Entry
    docPropsEntry <- DocProps -> P m Entry
    forall (m :: * -> *). PandocMonad m => DocProps -> P m Entry
    docPropsToEntry DocProps
    docProps
      -- we make a docProps/custom.xml entry out of the custom properties
      Entry
    docCustomPropsEntry <- DocProps -> P m Entry
    forall (m :: * -> *). PandocMonad m => DocProps -> P m Entry
    docCustomPropsToEntry DocProps
    docProps
      -- we make this ourself in case there's something unexpected in the
      -- one in the reference doc.
      Entry
    relsEntry <- P m Entry
    forall (m :: * -> *). PandocMonad m => P m Entry
    topLevelRelsEntry
      -- presentation entry and rels. We have to do the rels first to make
      -- sure we know the correct offset for the rIds.
      Entry
    presEntry <- Presentation -> P m Entry
    forall (m :: * -> *). PandocMonad m => Presentation -> P m Entry
    presentationToPresEntry Presentation
    p
      Entry
    presRelsEntry <- Presentation -> P m Entry
    forall (m :: * -> *). PandocMonad m => Presentation -> P m Entry
    presentationToRelsEntry Presentation
    p
      [Entry]
    slideEntries <- (Slide -> P m Entry)
    -> [Slide] -> ReaderT WriterEnv (StateT WriterState m) [Entry]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Slide -> P m Entry
    forall (m :: * -> *). PandocMonad m => Slide -> P m Entry
    slideToEntry [Slide]
    slides
      [Entry]
    slideRelEntries <- (Slide -> P m Entry)
    -> [Slide] -> ReaderT WriterEnv (StateT WriterState m) [Entry]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Slide -> P m Entry
    forall (m :: * -> *). PandocMonad m => Slide -> P m Entry
    slideToSlideRelEntry [Slide]
    slides
      [Entry]
    spkNotesEntries <- [Maybe Entry] -> [Entry]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe Entry] -> [Entry])
    -> ReaderT WriterEnv (StateT WriterState m) [Maybe Entry]
    -> ReaderT WriterEnv (StateT WriterState m) [Entry]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Slide -> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry))
    -> [Slide]
    -> ReaderT WriterEnv (StateT WriterState m) [Maybe Entry]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Slide -> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
    forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Entry)
    slideToSpeakerNotesEntry [Slide]
    slides
      [Entry]
    spkNotesRelEntries <- [Maybe Entry] -> [Entry]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe Entry] -> [Entry])
    -> ReaderT WriterEnv (StateT WriterState m) [Maybe Entry]
    -> ReaderT WriterEnv (StateT WriterState m) [Entry]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Slide -> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry))
    -> [Slide]
    -> ReaderT WriterEnv (StateT WriterState m) [Maybe Entry]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Slide -> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
    forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Entry)
    slideToSpeakerNotesRelEntry [Slide]
    slides
      -- These have to come after everything, because they need the info
      -- built up in the state.
      [Entry]
    mediaEntries <- ReaderT WriterEnv (StateT WriterState m) [Entry]
    forall (m :: * -> *). PandocMonad m => P m [Entry]
    makeMediaEntries
      Entry
    contentTypesEntry <- Presentation -> P m ContentTypes
    forall (m :: * -> *).
    PandocMonad m =>
    Presentation -> P m ContentTypes
    presentationToContentTypes Presentation
    p P m ContentTypes -> (ContentTypes -> P m Entry) -> P m Entry
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ContentTypes -> P m Entry
    forall (m :: * -> *). PandocMonad m => ContentTypes -> P m Entry
    contentTypesToEntry
      -- fold everything into our inherited archive and return it.
      Archive -> P m Archive
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Archive -> P m Archive) -> Archive -> P m Archive
    forall a b. (a -> b) -> a -> b
    $ (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Entry -> Archive -> Archive
    addEntryToArchive Archive
    newArch' ([Entry] -> Archive) -> [Entry] -> Archive
    forall a b. (a -> b) -> a -> b
    $
        [Entry]
    slideEntries [Entry] -> [Entry] -> [Entry]
    forall a. Semigroup a => a -> a -> a
    <>
        [Entry]
    slideRelEntries [Entry] -> [Entry] -> [Entry]
    forall a. Semigroup a => a -> a -> a
    <>
        [Entry]
    spkNotesEntries [Entry] -> [Entry] -> [Entry]
    forall a. Semigroup a => a -> a -> a
    <>
        [Entry]
    spkNotesRelEntries [Entry] -> [Entry] -> [Entry]
    forall a. Semigroup a => a -> a -> a
    <>
        [Entry]
    mediaEntries [Entry] -> [Entry] -> [Entry]
    forall a. Semigroup a => a -> a -> a
    <>
        [Entry
    contentTypesEntry, Entry
    docPropsEntry, Entry
    docCustomPropsEntry, Entry
    relsEntry,
         Entry
    presEntry, Entry
    presRelsEntry, Entry
    viewPropsEntry]

    makeSlideIdMap :: Presentation -> M.Map SlideId Int
    makeSlideIdMap :: Presentation -> Map SlideId Int
    makeSlideIdMap (Presentation _ slides :: [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` [1..]

    makeSpeakerNotesMap :: Presentation -> M.Map Int Int
    makeSpeakerNotesMap :: Presentation -> Map Int Int
    makeSpeakerNotesMap (Presentation _ slides :: [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` [1..]) [Int] -> [Int] -> [(Int, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [1..]
      where f :: (Slide, a) -> Maybe a
    f (Slide _ _ notes :: SpeakerNotes
    notes, n :: 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 -> Presentation -> m Archive
    presentationToArchive :: WriterOptions -> Presentation -> m Archive
    presentationToArchive opts :: WriterOptions
    opts pres :: Presentation
    pres = do
      Archive
    distArchive <- (ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> (ByteString -> ByteString) -> ByteString -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.fromStrict) (ByteString -> Archive) -> m ByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                          FilePath -> m ByteString
    forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
    P.readDefaultDataFile "reference.pptx"
      Archive
    refArchive <- case WriterOptions -> Maybe FilePath
    writerReferenceDoc WriterOptions
    opts of
                         Just f :: FilePath
    f  -> ByteString -> Archive
    toArchive (ByteString -> Archive) -> m ByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> m ByteString
    forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
    P.readFileLazy FilePath
    f
                         Nothing -> (ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> (ByteString -> ByteString) -> ByteString -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.fromStrict) (ByteString -> Archive) -> m ByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                            FilePath -> m ByteString
    forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
    P.readDataFile "reference.pptx"

      UTCTime
    utctime <- m UTCTime
    forall (m :: * -> *). PandocMonad m => m UTCTime
    P.getCurrentTime

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

      let env :: WriterEnv
    env = WriterEnv
    forall a. Default a => a
    def { envRefArchive :: Archive
    envRefArchive = Archive
    refArchive
                    , envDistArchive :: Archive
    envDistArchive = Archive
    distArchive
                    , envUTCTime :: UTCTime
    envUTCTime = UTCTime
    utctime
                    , envOpts :: WriterOptions
    envOpts = WriterOptions
    opts
                    , envPresentationSize :: (Pixels, Pixels)
    envPresentationSize = (Pixels, Pixels)
    presSize
                    , envSlideIdMap :: Map SlideId Int
    envSlideIdMap = Presentation -> Map SlideId Int
    makeSlideIdMap Presentation
    pres
                    , envSpeakerNotesIdMap :: Map Int Int
    envSpeakerNotesIdMap = Presentation -> Map Int Int
    makeSpeakerNotesMap Presentation
    pres
                    }

      let st :: WriterState
    st = WriterState
    forall a. Default a => a
    def { stMediaGlobalIds :: Map FilePath Int
    stMediaGlobalIds = Archive -> Archive -> Map FilePath Int
    initialGlobalIds Archive
    refArchive Archive
    distArchive
                   }

      WriterEnv -> WriterState -> P m Archive -> m Archive
    forall (m :: * -> *) a.
    Monad m =>
    WriterEnv -> WriterState -> P m a -> m a
    runP WriterEnv
    env WriterState
    st (P m Archive -> m Archive) -> P m Archive -> m Archive
    forall a b. (a -> b) -> a -> b
    $ Presentation -> P m Archive
    forall (m :: * -> *). PandocMonad m => Presentation -> P m Archive
    presentationToArchiveP Presentation
    pres

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

    -- 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 _ slides :: [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 :: 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)
    -> P m Bool
    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 :: Layout -> P m Element
    getLayout layout :: Layout
    layout = do
      let layoutpath :: FilePath
    layoutpath = case Layout
    layout of
            (MetadataSlide{}) -> "ppt/slideLayouts/slideLayout1.xml"
            (TitleSlide _)          -> "ppt/slideLayouts/slideLayout3.xml"
            (ContentSlide _ _)      -> "ppt/slideLayouts/slideLayout2.xml"
            (TwoColumnSlide{})    -> "ppt/slideLayouts/slideLayout4.xml"
      Archive
    refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      Archive
    distArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envDistArchive
      Archive -> Archive -> FilePath -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> FilePath -> m Element
    parseXml Archive
    refArchive Archive
    distArchive FilePath
    layoutpath

    shapeHasId :: NameSpaces -> T.Text -> Element -> Bool
    shapeHasId :: NameSpaces -> MimeType -> Element -> Bool
    shapeHasId ns :: NameSpaces
    ns ident :: MimeType
    ident element :: Element
    element
      | Just nvSpPr :: Element
    nvSpPr <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "nvSpPr") Element
    element
      , Just cNvPr :: Element
    cNvPr <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "cNvPr") Element
    nvSpPr
      , Just nm :: MimeType
    nm <- QName -> Element -> Maybe MimeType
    findAttrText (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "id" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    cNvPr =
          MimeType
    nm MimeType -> MimeType -> Bool
    forall a. Eq a => a -> a -> Bool
    == MimeType
    ident
      | Bool
    otherwise = Bool
    False

    getContentShape :: PandocMonad m => NameSpaces -> Element -> P m Element
    getContentShape :: NameSpaces -> Element -> P m Element
    getContentShape ns :: NameSpaces
    ns spTreeElem :: Element
    spTreeElem
      | NameSpaces -> FilePath -> FilePath -> Element -> Bool
    isElem NameSpaces
    ns "p" "spTree" Element
    spTreeElem = do
          ContentType
    contentType <- (WriterEnv -> ContentType)
    -> ReaderT WriterEnv (StateT WriterState m) ContentType
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> ContentType
    envContentType
          let contentShapes :: [Element]
    contentShapes = NameSpaces -> Element -> PHType -> [Element]
    getShapesByPlaceHolderType NameSpaces
    ns Element
    spTreeElem PHType
    ObjType
          case ContentType
    contentType of
            NormalContent | (sp :: Element
    sp : _) <- [Element]
    contentShapes -> Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return Element
    sp
            TwoColumnLeftContent | (sp :: Element
    sp : _) <- [Element]
    contentShapes -> Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return Element
    sp
            TwoColumnRightContent | (_ : sp :: Element
    sp : _) <- [Element]
    contentShapes -> Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return Element
    sp
            _ -> PandocError -> P m Element
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> P m Element) -> PandocError -> P m Element
    forall a b. (a -> b) -> a -> b
    $ MimeType -> PandocError
    PandocSomeError
                 "Could not find shape for Powerpoint content"
    getContentShape _ _ = PandocError -> P m Element
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> P m Element) -> PandocError -> P m Element
    forall a b. (a -> b) -> a -> b
    $ MimeType -> PandocError
    PandocSomeError
                          "Attempted to find content on non shapeTree"

    getShapeDimensions :: NameSpaces
                       -> Element
                       -> Maybe ((Integer, Integer), (Integer, Integer))
    getShapeDimensions :: NameSpaces -> Element -> Maybe ((Pixels, Pixels), (Pixels, Pixels))
    getShapeDimensions ns :: NameSpaces
    ns element :: Element
    element
      | NameSpaces -> FilePath -> FilePath -> Element -> Bool
    isElem NameSpaces
    ns "p" "sp" Element
    element = do
          Element
    spPr <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "spPr") Element
    element
          Element
    xfrm <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "a" "xfrm") Element
    spPr
          Element
    off <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "a" "off") Element
    xfrm
          FilePath
    xS <- QName -> Element -> Maybe FilePath
    findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "x" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    off
          FilePath
    yS <- QName -> Element -> Maybe FilePath
    findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "y" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    off
          Element
    ext <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "a" "ext") Element
    xfrm
          FilePath
    cxS <- QName -> Element -> Maybe FilePath
    findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "cx" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    ext
          FilePath
    cyS <- QName -> Element -> Maybe FilePath
    findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "cy" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    ext
          (x :: Pixels
    x, _) <- [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a. [a] -> Maybe a
    listToMaybe ([(Pixels, FilePath)] -> Maybe (Pixels, FilePath))
    -> [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a b. (a -> b) -> a -> b
    $ ReadS Pixels
    forall a. Read a => ReadS a
    reads FilePath
    xS
          (y :: Pixels
    y, _) <- [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a. [a] -> Maybe a
    listToMaybe ([(Pixels, FilePath)] -> Maybe (Pixels, FilePath))
    -> [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a b. (a -> b) -> a -> b
    $ ReadS Pixels
    forall a. Read a => ReadS a
    reads FilePath
    yS
          (cx :: Pixels
    cx, _) <- [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a. [a] -> Maybe a
    listToMaybe ([(Pixels, FilePath)] -> Maybe (Pixels, FilePath))
    -> [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a b. (a -> b) -> a -> b
    $ ReadS Pixels
    forall a. Read a => ReadS a
    reads FilePath
    cxS
          (cy :: Pixels
    cy, _) <- [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a. [a] -> Maybe a
    listToMaybe ([(Pixels, FilePath)] -> Maybe (Pixels, FilePath))
    -> [(Pixels, FilePath)] -> Maybe (Pixels, FilePath)
    forall a b. (a -> b) -> a -> b
    $ ReadS Pixels
    forall a. Read a => ReadS a
    reads FilePath
    cyS
          ((Pixels, Pixels), (Pixels, Pixels))
    -> Maybe ((Pixels, Pixels), (Pixels, Pixels))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Pixels
    x Pixels -> Pixels -> Pixels
    forall a. Integral a => a -> a -> a
    `div` 12700, Pixels
    y Pixels -> Pixels -> Pixels
    forall a. Integral a => a -> a -> a
    `div` 12700),
                  (Pixels
    cx Pixels -> Pixels -> Pixels
    forall a. Integral a => a -> a -> a
    `div` 12700, Pixels
    cy Pixels -> Pixels -> Pixels
    forall a. Integral a => a -> a -> a
    `div` 12700))
      | Bool
    otherwise = Maybe ((Pixels, Pixels), (Pixels, Pixels))
    forall a. Maybe a
    Nothing

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

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

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

    replaceNamedChildren :: NameSpaces
                         -> String
                         -> String
                         -> [Element]
                         -> Element
                         -> Element
    replaceNamedChildren :: NameSpaces
    -> FilePath -> FilePath -> [Element] -> Element -> Element
    replaceNamedChildren ns :: NameSpaces
    ns prefix :: FilePath
    prefix name :: FilePath
    name newKids :: [Element]
    newKids element :: Element
    element =
      Element
    element { elContent :: [Content]
    elContent = [[Content]] -> [Content]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Content]] -> [Content]) -> [[Content]] -> [Content]
    forall a b. (a -> b) -> a -> b
    $ Bool -> [Content] -> [[Content]]
    fun Bool
    True ([Content] -> [[Content]]) -> [Content] -> [[Content]]
    forall a b. (a -> b) -> a -> b
    $ Element -> [Content]
    elContent Element
    element }
      where
        fun :: Bool -> [Content] -> [[Content]]
        fun :: Bool -> [Content] -> [[Content]]
    fun _ [] = []
        fun switch :: Bool
    switch (Elem e :: Element
    e : conts :: [Content]
    conts) | NameSpaces -> FilePath -> FilePath -> Element -> Bool
    isElem NameSpaces
    ns FilePath
    prefix FilePath
    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 switch :: Bool
    switch (cont :: Content
    cont : conts :: [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 :: LinkTarget -> P m Int
    registerLink link :: LinkTarget
    link = do
      Int
    curSlideId <- (WriterEnv -> Int) -> P m Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Int
    envCurSlideId
      Map Int (Map Int LinkTarget)
    linkReg <- (WriterState -> Map Int (Map Int LinkTarget))
    -> ReaderT
         WriterEnv (StateT WriterState m) (Map Int (Map Int LinkTarget))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Map Int (Map Int LinkTarget)
    stLinkIds
      Map Int [MediaInfo]
    mediaReg <- (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
      Bool
    hasSpeakerNotes <- P m Bool
    forall (m :: * -> *). PandocMonad m => P m Bool
    curSlideHasSpeakerNotes
      let maxLinkId :: Int
    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 of
            Just mp :: Map Int LinkTarget
    mp -> case Map Int LinkTarget -> [Int]
    forall k a. Map k a -> [k]
    M.keys Map Int LinkTarget
    mp of
              [] -> if Bool
    hasSpeakerNotes then 2 else 1
              ks :: [Int]
    ks -> [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [Int]
    ks
            Nothing -> if Bool
    hasSpeakerNotes then 2 else 1
          maxMediaId :: Int
    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 of
            Just [] -> if Bool
    hasSpeakerNotes then 2 else 1
            Just mInfos :: [MediaInfo]
    mInfos -> [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (MediaInfo -> Int) -> [MediaInfo] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map MediaInfo -> Int
    mInfoLocalId [MediaInfo]
    mInfos
            Nothing -> if Bool
    hasSpeakerNotes then 2 else 1
          maxId :: Int
    maxId = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    maxLinkId Int
    maxMediaId
          slideLinks :: Map Int LinkTarget
    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 mp :: 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
    + 1) LinkTarget
    link Map Int LinkTarget
    mp
            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
    + 1) LinkTarget
    link
      (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \st :: WriterState
    st -> WriterState
    st{ stLinkIds :: Map Int (Map Int LinkTarget)
    stLinkIds = Int
    -> Map Int LinkTarget
    -> Map Int (Map Int LinkTarget)
    -> Map Int (Map Int LinkTarget)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Int
    curSlideId Map Int LinkTarget
    slideLinks Map Int (Map Int LinkTarget)
    linkReg}
      Int -> P m Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> P m Int) -> Int -> P m Int
    forall a b. (a -> b) -> a -> b
    $ Int
    maxId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1

    registerMedia :: PandocMonad m => FilePath -> [ParaElem] -> P m MediaInfo
    registerMedia :: FilePath -> [ParaElem] -> P m MediaInfo
    registerMedia fp :: FilePath
    fp caption :: [ParaElem]
    caption = do
      Int
    curSlideId <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Int
    envCurSlideId
      Map Int (Map Int LinkTarget)
    linkReg <- (WriterState -> Map Int (Map Int LinkTarget))
    -> ReaderT
         WriterEnv (StateT WriterState m) (Map Int (Map Int LinkTarget))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Map Int (Map Int LinkTarget)
    stLinkIds
      Map Int [MediaInfo]
    mediaReg <- (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
      Map FilePath Int
    globalIds <- (WriterState -> Map FilePath Int)
    -> ReaderT WriterEnv (StateT WriterState m) (Map FilePath Int)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Map FilePath Int
    stMediaGlobalIds
      Bool
    hasSpeakerNotes <- P m Bool
    forall (m :: * -> *). PandocMonad m => P m Bool
    curSlideHasSpeakerNotes
      let maxLinkId :: Int
    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 of
            Just mp :: Map Int LinkTarget
    mp -> case Map Int LinkTarget -> [Int]
    forall k a. Map k a -> [k]
    M.keys Map Int LinkTarget
    mp of
              [] -> if Bool
    hasSpeakerNotes then 2 else 1
              ks :: [Int]
    ks -> [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [Int]
    ks
            Nothing -> if Bool
    hasSpeakerNotes then 2 else 1
          maxMediaId :: Int
    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 of
            Just [] -> if Bool
    hasSpeakerNotes then 2 else 1
            Just mInfos :: [MediaInfo]
    mInfos -> [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (MediaInfo -> Int) -> [MediaInfo] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map MediaInfo -> Int
    mInfoLocalId [MediaInfo]
    mInfos
            Nothing -> if Bool
    hasSpeakerNotes then 2 else 1
          maxLocalId :: Int
    maxLocalId = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    maxLinkId Int
    maxMediaId

          maxGlobalId :: Int
    maxGlobalId = case Map FilePath Int -> [Int]
    forall k a. Map k a -> [a]
    M.elems Map FilePath Int
    globalIds of
            [] -> 0
            ids :: [Int]
    ids -> [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [Int]
    ids

      (imgBytes :: ByteString
    imgBytes, mbMt :: Maybe MimeType
    mbMt) <- MimeType
    -> ReaderT
         WriterEnv (StateT WriterState m) (ByteString, Maybe MimeType)
    forall (m :: * -> *).
    PandocMonad m =>
    MimeType -> m (ByteString, Maybe MimeType)
    P.fetchItem (MimeType
     -> ReaderT
          WriterEnv (StateT WriterState m) (ByteString, Maybe MimeType))
    -> MimeType
    -> ReaderT
         WriterEnv (StateT WriterState m) (ByteString, Maybe MimeType)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> MimeType
    T.pack FilePath
    fp
      let imgExt :: Maybe MimeType
    imgExt = (Maybe MimeType
    mbMt Maybe MimeType -> (MimeType -> Maybe MimeType) -> Maybe MimeType
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MimeType -> Maybe MimeType
    extensionFromMimeType Maybe MimeType -> (MimeType -> Maybe MimeType) -> Maybe MimeType
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\x :: MimeType
    x -> MimeType -> Maybe MimeType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MimeType -> Maybe MimeType) -> MimeType -> Maybe MimeType
    forall a b. (a -> b) -> a -> b
    $ "." MimeType -> MimeType -> MimeType
    forall a. Semigroup a => a -> a -> a
    <> MimeType
    x))
                   Maybe MimeType -> Maybe MimeType -> Maybe MimeType
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
                   case ByteString -> Maybe ImageType
    imageType ByteString
    imgBytes of
                     Just Png  -> MimeType -> Maybe MimeType
    forall a. a -> Maybe a
    Just ".png"
                     Just Jpeg -> MimeType -> Maybe MimeType
    forall a. a -> Maybe a
    Just ".jpeg"
                     Just Gif  -> MimeType -> Maybe MimeType
    forall a. a -> Maybe a
    Just ".gif"
                     Just Pdf  -> MimeType -> Maybe MimeType
    forall a. a -> Maybe a
    Just ".pdf"
                     Just Eps  -> MimeType -> Maybe MimeType
    forall a. a -> Maybe a
    Just ".eps"
                     Just Svg  -> MimeType -> Maybe MimeType
    forall a. a -> Maybe a
    Just ".svg"
                     Just Emf  -> MimeType -> Maybe MimeType
    forall a. a -> Maybe a
    Just ".emf"
                     Nothing   -> Maybe MimeType
    forall a. Maybe a
    Nothing

      let newGlobalId :: Int
    newGlobalId = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (Int
    maxGlobalId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 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 :: Map FilePath Int
    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
    mediaInfo = MediaInfo :: FilePath
    -> Int
    -> Int
    -> Maybe MimeType
    -> Maybe MimeType
    -> Bool
    -> MediaInfo
    MediaInfo { mInfoFilePath :: FilePath
    mInfoFilePath = FilePath
    fp
                                , mInfoLocalId :: Int
    mInfoLocalId = Int
    maxLocalId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1
                                , mInfoGlobalId :: Int
    mInfoGlobalId = Int
    newGlobalId
                                , mInfoMimeType :: Maybe MimeType
    mInfoMimeType = Maybe MimeType
    mbMt
                                , mInfoExt :: Maybe MimeType
    mInfoExt = Maybe MimeType
    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 (t :: * -> *) a. Foldable t => t a -> Bool
    null) [ParaElem]
    caption
                                }

      let slideMediaInfos :: [MediaInfo]
    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 minfos :: [MediaInfo]
    minfos -> MediaInfo
    mediaInfo MediaInfo -> [MediaInfo] -> [MediaInfo]
    forall a. a -> [a] -> [a]
    : [MediaInfo]
    minfos
            Nothing     -> [MediaInfo
    mediaInfo]

      (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \st :: WriterState
    st -> WriterState
    st{ stMediaIds :: Map Int [MediaInfo]
    stMediaIds = Int -> [MediaInfo] -> Map Int [MediaInfo] -> Map Int [MediaInfo]
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Int
    curSlideId [MediaInfo]
    slideMediaInfos Map Int [MediaInfo]
    mediaReg
                        , stMediaGlobalIds :: Map FilePath Int
    stMediaGlobalIds = Map FilePath Int
    newGlobalIds
                        }
      MediaInfo -> P m MediaInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return MediaInfo
    mediaInfo

    makeMediaEntry :: PandocMonad m => MediaInfo -> P m Entry
    makeMediaEntry :: MediaInfo -> P m Entry
    makeMediaEntry mInfo :: MediaInfo
    mInfo = do
      Pixels
    epochtime <- (POSIXTime -> Pixels
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (POSIXTime -> Pixels)
    -> (UTCTime -> POSIXTime) -> UTCTime -> Pixels
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> POSIXTime
    utcTimeToPOSIXSeconds) (UTCTime -> Pixels)
    -> ReaderT WriterEnv (StateT WriterState m) UTCTime
    -> ReaderT WriterEnv (StateT WriterState m) Pixels
    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 :: ByteString
    imgBytes, _) <- MimeType
    -> ReaderT
         WriterEnv (StateT WriterState m) (ByteString, Maybe MimeType)
    forall (m :: * -> *).
    PandocMonad m =>
    MimeType -> m (ByteString, Maybe MimeType)
    P.fetchItem (FilePath -> MimeType
    T.pack (FilePath -> MimeType) -> FilePath -> MimeType
    forall a b. (a -> b) -> a -> b
    $ MediaInfo -> FilePath
    mInfoFilePath MediaInfo
    mInfo)
      let ext :: MimeType
    ext = MimeType -> Maybe MimeType -> MimeType
    forall a. a -> Maybe a -> a
    fromMaybe "" (MediaInfo -> Maybe MimeType
    mInfoExt MediaInfo
    mInfo)
      let fp :: FilePath
    fp = "ppt/media/image" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
              Int -> FilePath
    forall a. Show a => a -> FilePath
    show (MediaInfo -> Int
    mInfoGlobalId MediaInfo
    mInfo) FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> MimeType -> FilePath
    T.unpack MimeType
    ext
      Entry -> P m Entry
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Entry -> P m Entry) -> Entry -> P m Entry
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Pixels -> ByteString -> Entry
    toEntry FilePath
    fp Pixels
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    BL.fromStrict ByteString
    imgBytes

    makeMediaEntries :: PandocMonad m => P m [Entry]
    makeMediaEntries :: P m [Entry]
    makeMediaEntries = do
      Map Int [MediaInfo]
    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]
    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
      (MediaInfo -> ReaderT WriterEnv (StateT WriterState m) Entry)
    -> [MediaInfo] -> P m [Entry]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM MediaInfo -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall (m :: * -> *). PandocMonad m => MediaInfo -> P m Entry
    makeMediaEntry [MediaInfo]
    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 :: P m Element
    getMaster = do
      Archive
    refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      Archive
    distArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envDistArchive
      Archive -> Archive -> FilePath -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> FilePath -> m Element
    parseXml Archive
    refArchive Archive
    distArchive "ppt/slideMasters/slideMaster1.xml"

    -- 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 :: Pixels
    captionHeight = 40

    createCaption :: PandocMonad m
                  => ((Integer, Integer), (Integer, Integer))
                  -> [ParaElem]
                  -> P m Element
    createCaption :: ((Pixels, Pixels), (Pixels, Pixels)) -> [ParaElem] -> P m Element
    createCaption contentShapeDimensions :: ((Pixels, Pixels), (Pixels, Pixels))
    contentShapeDimensions paraElements :: [ParaElem]
    paraElements = do
      let para :: Paragraph
    para = ParaProps -> [ParaElem] -> Paragraph
    Paragraph ParaProps
    forall a. Default a => a
    def{pPropAlign :: Maybe Algnment
    pPropAlign = Algnment -> Maybe Algnment
    forall a. a -> Maybe a
    Just Algnment
    AlgnCenter} [ParaElem]
    paraElements
      [Element]
    elements <- (Paragraph -> P 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)
    mapM Paragraph -> P m Element
    forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
    paragraphToElement [Paragraph
    para]
      let ((x :: Pixels
    x, y :: Pixels
    y), (cx :: Pixels
    cx, cy :: Pixels
    cy)) = ((Pixels, Pixels), (Pixels, Pixels))
    contentShapeDimensions
      let txBody :: Element
    txBody = FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:txBody" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                   [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:bodyPr" [] (), FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    elements
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $
        FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sp" [] [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:nvSpPr" []
                           [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cNvPr" [("id","1"), ("name","TextBox 3")] ()
                           , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cNvSpPr" [("txBox", "1")] ()
                           , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:nvPr" [] ()
                           ]
                         , FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:spPr" []
                           [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:xfrm" []
                             [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:off" [("x", Pixels -> FilePath
    forall a. Show a => a -> FilePath
    show (Pixels -> FilePath) -> Pixels -> FilePath
    forall a b. (a -> b) -> a -> b
    $ 12700 Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * Pixels
    x),
                                               ("y", Pixels -> FilePath
    forall a. Show a => a -> FilePath
    show (Pixels -> FilePath) -> Pixels -> FilePath
    forall a b. (a -> b) -> a -> b
    $ 12700 Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * (Pixels
    y Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    + Pixels
    cy Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    - Pixels
    captionHeight))] ()
                             , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:ext" [("cx", Pixels -> FilePath
    forall a. Show a => a -> FilePath
    show (Pixels -> FilePath) -> Pixels -> FilePath
    forall a b. (a -> b) -> a -> b
    $ 12700 Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * Pixels
    cx),
                                               ("cy", Pixels -> FilePath
    forall a. Show a => a -> FilePath
    show (Pixels -> FilePath) -> Pixels -> FilePath
    forall a b. (a -> b) -> a -> b
    $ 12700 Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * Pixels
    captionHeight)] ()
                             ]
                           , FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:prstGeom" [("prst", "rect")]
                             [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:avLst" [] ()
                             ]
                           , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:noFill" [] ()
                           ]
                         , Element
    txBody
                         ]

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

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

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

          (dimX' :: Pixels
    dimX', dimY' :: Pixels
    dimY') = (Double -> Pixels
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    dimX Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * 12700, Double -> Pixels
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    dimY Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * 12700) :: (Integer, Integer)
          (xoff :: Double
    xoff, yoff :: Double
    yoff) = (Pixels -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Pixels
    x Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + (Pixels -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Pixels
    cx Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    dimX) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / 2,
                          Pixels -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Pixels
    y Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + (Pixels -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Pixels
    cy Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    dimY) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / 2)
          (xoff' :: Pixels
    xoff', yoff' :: Pixels
    yoff') = (Double -> Pixels
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    xoff Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * 12700, Double -> Pixels
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    yoff Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * 12700) :: (Integer, Integer)

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

      let picShape :: Element
    picShape = FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:pic" []
                     [ Element
    nvPicPr
                     , Element
    blipFill
                     , Element
    spPr ]

      -- And now, maybe create the caption:
      if Bool
    hasCaption
        then do Element
    cap <- ((Pixels, Pixels), (Pixels, Pixels)) -> [ParaElem] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ((Pixels, Pixels), (Pixels, Pixels)) -> [ParaElem] -> P m Element
    createCaption ((Pixels
    x, Pixels
    y), (Pixels
    cx, Pixels
    cytmp)) [ParaElem]
    alt
                [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element
    picShape, Element
    cap]
        else [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element
    picShape]

    paraElemToElements :: PandocMonad m => ParaElem -> P m [Element]
    paraElemToElements :: ParaElem -> P m [Element]
    paraElemToElements Break = [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:br" [] ()]
    paraElemToElements (Run rpr :: RunProps
    rpr s :: MimeType
    s) = do
      NameSpaces
    sizeAttrs <- RunProps -> P m NameSpaces
    forall (m :: * -> *). Monad m => RunProps -> P m NameSpaces
    fontSizeAttributes RunProps
    rpr
      let attrs :: NameSpaces
    attrs = NameSpaces
    sizeAttrs NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
            (
            [("b", "1") | RunProps -> Bool
    rPropBold RunProps
    rpr]) NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
            (
            [("i", "1") | RunProps -> Bool
    rPropItalics RunProps
    rpr]) NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
            (
            [("u", "sng") | RunProps -> Bool
    rPropUnderline RunProps
    rpr]) NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
            (case RunProps -> Maybe Strikethrough
    rStrikethrough RunProps
    rpr of
                Just NoStrike     -> [("strike", "noStrike")]
                Just SingleStrike -> [("strike", "sngStrike")]
                Just DoubleStrike -> [("strike", "dblStrike")]
                Nothing -> []) NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
            (case RunProps -> Maybe Int
    rBaseline RunProps
    rpr of
                Just n :: Int
    n -> [("baseline", Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n)]
                Nothing -> []) NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
            (case RunProps -> Maybe Capitals
    rCap RunProps
    rpr of
                Just NoCapitals -> [("cap", "none")]
                Just SmallCapitals -> [("cap", "small")]
                Just AllCapitals -> [("cap", "all")]
                Nothing -> []) NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
            []
      [Element]
    linkProps <- case RunProps -> Maybe LinkTarget
    rLink RunProps
    rpr of
                     Just link :: LinkTarget
    link -> do
                       Int
    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.
                       [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> P m [Element]) -> [Element] -> P m [Element]
    forall a b. (a -> b) -> a -> b
    $ case LinkTarget
    link of
                         InternalTarget _ ->
                           let linkAttrs :: NameSpaces
    linkAttrs =
                                 [ ("r:id", "rId" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    idNum)
                                 , ("action", "ppaction://hlinksldjump")
                                 ]
                           in [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:hlinkClick" NameSpaces
    linkAttrs ()]
                         -- external
                         ExternalTarget _ ->
                           let linkAttrs :: NameSpaces
    linkAttrs =
                                 [ ("r:id", "rId" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    idNum)
                                 ]
                           in [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:hlinkClick" NameSpaces
    linkAttrs ()]
                     Nothing -> [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      let colorContents :: [Element]
    colorContents = case RunProps -> Maybe Color
    rSolidFill RunProps
    rpr of
                            Just color :: Color
    color ->
                              case Color -> FilePath
    forall a. FromColor a => Color -> a
    fromColor Color
    color of
                                '#':hx :: FilePath
    hx ->  [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:solidFill" []
                                            [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:srgbClr" [("val", (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper FilePath
    hx)] ()]
                                           ]
                                _ -> []
                            Nothing -> []
      MimeType
    codeFont <- P m MimeType
    forall (m :: * -> *). Monad m => P m MimeType
    monospaceFont
      let codeContents :: [Element]
    codeContents =
            [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:latin" [("typeface", MimeType -> FilePath
    T.unpack MimeType
    codeFont)] () | RunProps -> Bool
    rPropCode RunProps
    rpr]
      let propContents :: [Element]
    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
      [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:r" [] [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:rPr" NameSpaces
    attrs [Element]
    propContents
                              , FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:t" [] (FilePath -> Element) -> FilePath -> Element
    forall a b. (a -> b) -> a -> b
    $ MimeType -> FilePath
    T.unpack MimeType
    s
                              ]]
    paraElemToElements (MathElem mathType :: MathType
    mathType texStr :: TeXString
    texStr) = do
      Either Inline Element
    res <- (DisplayType -> [Exp] -> Element)
    -> MathType
    -> MimeType
    -> ReaderT WriterEnv (StateT WriterState m) (Either Inline Element)
    forall (m :: * -> *) a.
    PandocMonad m =>
    (DisplayType -> [Exp] -> a)
    -> MathType -> MimeType -> m (Either Inline a)
    convertMath DisplayType -> [Exp] -> Element
    writeOMML MathType
    mathType (TeXString -> MimeType
    unTeXString TeXString
    texStr)
      case Either Inline Element
    res of
        Right r :: Element
    r -> [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [FilePath -> NameSpaces -> Element -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a14:m" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Element -> Element
    addMathInfo Element
    r]
        Left (Str s :: MimeType
    s) -> ParaElem -> P m [Element]
    forall (m :: * -> *). PandocMonad m => ParaElem -> P m [Element]
    paraElemToElements (RunProps -> MimeType -> ParaElem
    Run RunProps
    forall a. Default a => a
    def MimeType
    s)
        Left _       -> PandocError -> P m [Element]
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> P m [Element]) -> PandocError -> P m [Element]
    forall a b. (a -> b) -> a -> b
    $ MimeType -> PandocError
    PandocShouldNeverHappenError "non-string math fallback"
    paraElemToElements (RawOOXMLParaElem str :: MimeType
    str) = [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Element
    x | Elem x :: Element
    x <- MimeType -> [Content]
    forall s. XmlSource s => s -> [Content]
    parseXML MimeType
    str ]

    -- 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
    element =
      let mathspace :: Attr
    mathspace = Attr :: QName -> FilePath -> Attr
    Attr { attrKey :: QName
    attrKey = FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "m" Maybe FilePath
    forall a. Maybe a
    Nothing (FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just "xmlns")
                           , attrVal :: FilePath
    attrVal = "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
    element =
      case QName -> Element -> Maybe Element
    findElement (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "m" Maybe FilePath
    forall a. Maybe a
    Nothing (FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just "a14")) Element
    element of
        Just _ ->
          FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "mc:AlternateContent"
             [("xmlns:mc", "http://schemas.openxmlformats.org/markup-compatibility/2006")
             ] [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "mc:Choice"
                 [ ("xmlns:a14", "http://schemas.microsoft.com/office/drawing/2010/main")
                 , ("Requires", "a14")] [ Element
    element ]
               ]
        Nothing -> Element
    element

    paragraphToElement :: PandocMonad m => Paragraph -> P m Element
    paragraphToElement :: Paragraph -> P m Element
    paragraphToElement par :: Paragraph
    par = do
      let
        attrs :: NameSpaces
    attrs = [("lvl", Int -> FilePath
    forall a. Show a => a -> FilePath
    show (Int -> FilePath) -> Int -> FilePath
    forall a b. (a -> b) -> a -> b
    $ ParaProps -> Int
    pPropLevel (ParaProps -> Int) -> ParaProps -> Int
    forall a b. (a -> b) -> a -> b
    $ Paragraph -> ParaProps
    paraProps Paragraph
    par)] NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
                (case ParaProps -> Maybe Pixels
    pPropMarginLeft (Paragraph -> ParaProps
    paraProps Paragraph
    par) of
                   Just px :: Pixels
    px -> [("marL", Pixels -> FilePath
    forall a. Show a => a -> FilePath
    show (Pixels -> FilePath) -> Pixels -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Pixels -> Pixels
    pixelsToEmu Pixels
    px)]
                   Nothing -> []
                ) NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
                (case ParaProps -> Maybe Pixels
    pPropIndent (Paragraph -> ParaProps
    paraProps Paragraph
    par) of
                   Just px :: Pixels
    px -> [("indent", Pixels -> FilePath
    forall a. Show a => a -> FilePath
    show (Pixels -> FilePath) -> Pixels -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Pixels -> Pixels
    pixelsToEmu Pixels
    px)]
                   Nothing -> []
                ) NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <>
                (case ParaProps -> Maybe Algnment
    pPropAlign (Paragraph -> ParaProps
    paraProps Paragraph
    par) of
                   Just AlgnLeft -> [("algn", "l")]
                   Just AlgnRight -> [("algn", "r")]
                   Just AlgnCenter -> [("algn", "ctr")]
                   Nothing -> []
                )
        props :: [Element]
    props = [] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <>
                (case ParaProps -> Maybe Pixels
    pPropSpaceBefore (ParaProps -> Maybe Pixels) -> ParaProps -> Maybe Pixels
    forall a b. (a -> b) -> a -> b
    $ Paragraph -> ParaProps
    paraProps Paragraph
    par of
                   Just px :: Pixels
    px -> [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:spcBef" [] [
                                  FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:spcPts" [("val", Pixels -> FilePath
    forall a. Show a => a -> FilePath
    show (Pixels -> FilePath) -> Pixels -> FilePath
    forall a b. (a -> b) -> a -> b
    $ 100 Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * Pixels
    px)] ()
                                  ]
                              ]
                   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 Bullet -> []
                   Just (AutoNumbering attrs' :: ListAttributes
    attrs') ->
                     [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:buAutoNum" (ListAttributes -> NameSpaces
    autoNumAttrs ListAttributes
    attrs') ()]
                   Nothing -> [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:buNone" [] ()]
                )
      [Element]
    paras <- [[Element]] -> [Element]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Element]] -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParaElem -> ReaderT WriterEnv (StateT WriterState m) [Element])
    -> [ParaElem]
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ParaElem -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *). PandocMonad m => ParaElem -> P m [Element]
    paraElemToElements (Paragraph -> [ParaElem]
    paraElems Paragraph
    par)
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:p" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:pPr" NameSpaces
    attrs [Element]
    props] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    paras

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

    shapeToElements :: PandocMonad m => Element -> Shape -> P m [Element]
    shapeToElements :: Element -> Shape -> P m [Element]
    shapeToElements layout :: Element
    layout (Pic picProps :: PicProps
    picProps fp :: FilePath
    fp alt :: [ParaElem]
    alt) = do
      MediaInfo
    mInfo <- FilePath -> [ParaElem] -> P m MediaInfo
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> [ParaElem] -> P m MediaInfo
    registerMedia FilePath
    fp [ParaElem]
    alt
      case MediaInfo -> Maybe MimeType
    mInfoExt MediaInfo
    mInfo of
        Just _ ->
          Element -> PicProps -> MediaInfo -> [ParaElem] -> P m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> PicProps -> MediaInfo -> [ParaElem] -> P m [Element]
    makePicElements Element
    layout PicProps
    picProps MediaInfo
    mInfo [ParaElem]
    alt
        Nothing -> Element -> Shape -> P m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> Shape -> P m [Element]
    shapeToElements Element
    layout (Shape -> P m [Element]) -> Shape -> P m [Element]
    forall a b. (a -> b) -> a -> b
    $ [Paragraph] -> Shape
    TextBox [ParaProps -> [ParaElem] -> Paragraph
    Paragraph ParaProps
    forall a. Default a => a
    def [ParaElem]
    alt]
    shapeToElements layout :: Element
    layout (GraphicFrame tbls :: [Graphic]
    tbls cptn :: [ParaElem]
    cptn) =
      Element -> [Graphic] -> [ParaElem] -> P m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [Graphic] -> [ParaElem] -> P m [Element]
    graphicFrameToElements Element
    layout [Graphic]
    tbls [ParaElem]
    cptn
    shapeToElements _ (RawOOXMLShape str :: MimeType
    str) = [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Element
    x | Elem x :: Element
    x <- MimeType -> [Content]
    forall s. XmlSource s => s -> [Content]
    parseXML MimeType
    str ]
    shapeToElements layout :: Element
    layout shp :: Shape
    shp = do
      Element
    element <- Element -> Shape -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> Shape -> P m Element
    shapeToElement Element
    layout Shape
    shp
      [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element
    element]

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

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

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

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

      if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [ParaElem] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    caption
        then do Element
    capElt <- ((Pixels, Pixels), (Pixels, Pixels)) -> [ParaElem] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ((Pixels, Pixels), (Pixels, Pixels)) -> [ParaElem] -> P m Element
    createCaption ((Pixels
    x, Pixels
    y), (Pixels
    cx, Pixels
    cytmp)) [ParaElem]
    caption
                [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element
    graphicFrameElts, Element
    capElt]
        else [Element] -> P m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element
    graphicFrameElts]

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

    graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element
    graphicToElement :: Pixels -> Graphic -> P m Element
    graphicToElement tableWidth :: Pixels
    tableWidth (Tbl tblPr :: TableProps
    tblPr hdrCells :: [[Paragraph]]
    hdrCells rows :: [[[Paragraph]]]
    rows) = do
      let colWidths :: [Pixels]
    colWidths = if [[Paragraph]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Paragraph]]
    hdrCells
                      then case [[[Paragraph]]]
    rows of
                             r :: [[Paragraph]]
    r : _ | Bool -> Bool
    not ([[Paragraph]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Paragraph]]
    r) -> Int -> Pixels -> [Pixels]
    forall a. Int -> a -> [a]
    replicate ([[Paragraph]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Paragraph]]
    r) (Pixels -> [Pixels]) -> Pixels -> [Pixels]
    forall a b. (a -> b) -> a -> b
    $
                                                     Pixels
    tableWidth Pixels -> Pixels -> Pixels
    forall a. Integral a => a -> a -> a
    `div` Int -> Pixels
    forall a. Integral a => a -> Pixels
    toInteger ([[Paragraph]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Paragraph]]
    r)
                             -- satisfy the compiler. This is the same as
                             -- saying that rows is empty, but the compiler
                             -- won't understand that `[]` exhausts the
                             -- alternatives.
                             _ -> []
                      else Int -> Pixels -> [Pixels]
    forall a. Int -> a -> [a]
    replicate ([[Paragraph]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Paragraph]]
    hdrCells) (Pixels -> [Pixels]) -> Pixels -> [Pixels]
    forall a b. (a -> b) -> a -> b
    $
                           Pixels
    tableWidth Pixels -> Pixels -> Pixels
    forall a. Integral a => a -> a -> a
    `div` Int -> Pixels
    forall a. Integral a => a -> Pixels
    toInteger ([[Paragraph]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Paragraph]]
    hdrCells)

      let cellToOpenXML :: [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    cellToOpenXML paras :: [Paragraph]
    paras =
            do [Element]
    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)
    mapM Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
    paragraphToElement [Paragraph]
    paras
               let elements' :: [Element]
    elements' = if [Element] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Element]
    elements
                               then [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:p" [] [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:endParaRPr" [] ()]]
                               else [Element]
    elements

               [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                 [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:txBody" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                   [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:bodyPr" [] ()
                   , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:lstStyle" [] ()]
                   [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    elements']
      [[Element]]
    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)
    mapM [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    cellToOpenXML [[Paragraph]]
    hdrCells
      [[[Element]]]
    rows' <- ([[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)
    mapM (([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)
    mapM [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    cellToOpenXML) [[[Paragraph]]]
    rows
      let borderProps :: Element
    borderProps = FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:tcPr" [] ()
      let emptyCell :: [Element]
    emptyCell = [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:p" [] [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:pPr" [] ()]]
      let mkcell :: Bool -> [Element] -> Element
    mkcell border :: Bool
    border contents :: [Element]
    contents = FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:tc" []
                                ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ (if [Element] -> 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 -> [[Element]] -> Element
    mkrow border :: Bool
    border cells :: [[Element]]
    cells = FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:tr" [("h", "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 :: Pixels -> Element
    mkgridcol w :: Pixels
    w = FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:gridCol"
                           [("w", Pixels -> FilePath
    forall a. Show a => a -> FilePath
    show ((12700 Pixels -> Pixels -> Pixels
    forall a. Num a => a -> a -> a
    * Pixels
    w) :: Integer))] ()
      let hasHeader :: Bool
    hasHeader = Bool -> Bool
    not (([Paragraph] -> Bool) -> [[Paragraph]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [Paragraph] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Paragraph]]
    hdrCells)

      Maybe MimeType
    mbDefTblStyle <- P m (Maybe MimeType)
    forall (m :: * -> *). PandocMonad m => P m (Maybe MimeType)
    getDefaultTableStyle
      let tblPrElt :: Element
    tblPrElt = FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:tblPr"
                     [ ("firstRow", if TableProps -> Bool
    tblPrFirstRow TableProps
    tblPr then "1" else "0")
                     , ("bandRow", if TableProps -> Bool
    tblPrBandRow TableProps
    tblPr then "1" else "0")
                     ] (case Maybe MimeType
    mbDefTblStyle of
                          Nothing -> []
                          Just sty :: MimeType
    sty -> [FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:tableStyleId" [] (FilePath -> Element) -> FilePath -> Element
    forall a b. (a -> b) -> a -> b
    $ MimeType -> FilePath
    T.unpack MimeType
    sty])

      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:graphic" []
        [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")]
         [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:tbl" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
          [ Element
    tblPrElt
          , FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:tblGrid" [] (if (Pixels -> Bool) -> [Pixels] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Pixels -> Pixels -> Bool
    forall a. Eq a => a -> a -> Bool
    ==0) [Pixels]
    colWidths
                                   then []
                                   else (Pixels -> Element) -> [Pixels] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map Pixels -> Element
    mkgridcol [Pixels]
    colWidths)
          ]
          [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [ Bool -> [[Element]] -> Element
    mkrow Bool
    True [[Element]]
    headers' | Bool
    hasHeader ] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> ([[Element]] -> Element) -> [[[Element]]] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> [[Element]] -> Element
    mkrow Bool
    False) [[[Element]]]
    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 -> ShowS
    [PHType] -> ShowS
    PHType -> FilePath
    (Int -> PHType -> ShowS)
    -> (PHType -> FilePath) -> ([PHType] -> ShowS) -> Show PHType
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    showList :: [PHType] -> ShowS
    $cshowList :: [PHType] -> ShowS
    show :: PHType -> FilePath
    $cshow :: PHType -> FilePath
    showsPrec :: Int -> PHType -> ShowS
    $cshowsPrec :: Int -> PHType -> ShowS
    Show, PHType -> PHType -> Bool
    (PHType -> PHType -> Bool)
    -> (PHType -> PHType -> Bool) -> Eq PHType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: PHType -> PHType -> Bool
    $c/= :: PHType -> PHType -> Bool
    == :: PHType -> PHType -> Bool
    $c== :: PHType -> PHType -> Bool
    Eq)

    findPHType :: NameSpaces -> Element -> PHType -> Bool
    findPHType :: NameSpaces -> Element -> PHType -> Bool
    findPHType ns :: NameSpaces
    ns spElem :: Element
    spElem phType :: PHType
    phType
      | NameSpaces -> FilePath -> FilePath -> Element -> Bool
    isElem NameSpaces
    ns "p" "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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "nvSpPr") Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "nvPr") Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "ph"))
        in
          case Maybe Element
    mbPHElem of
            -- if it's a named PHType, we want to check that the attribute
            -- value matches.
            Just phElem :: Element
    phElem | (PHType tp :: MimeType
    tp) <- PHType
    phType ->
                            case QName -> Element -> Maybe MimeType
    findAttrText (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "type" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    phElem of
                              Just tp' :: MimeType
    tp' -> MimeType
    tp MimeType -> MimeType -> Bool
    forall a. Eq a => a -> a -> Bool
    == MimeType
    tp'
                              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 phElem :: Element
    phElem | PHType
    ObjType <- PHType
    phType ->
                            case QName -> Element -> Maybe FilePath
    findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "type" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    phElem of
                              Just _ -> Bool
    False
                              Nothing -> Bool
    True
            Nothing -> Bool
    False
    findPHType _ _ _ = Bool
    False

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

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

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

    nonBodyTextToElement :: PandocMonad m => Element -> [PHType] -> [ParaElem] -> P m Element
    nonBodyTextToElement :: Element -> [PHType] -> [ParaElem] -> P m Element
    nonBodyTextToElement layout :: Element
    layout phTypes :: [PHType]
    phTypes paraElements :: [ParaElem]
    paraElements
      | NameSpaces
    ns <- Element -> NameSpaces
    elemToNameSpaces Element
    layout
      , Just cSld :: Element
    cSld <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "cSld") Element
    layout
      , Just spTree :: Element
    spTree <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "spTree") Element
    cSld
      , Just sp :: Element
    sp <- NameSpaces -> Element -> [PHType] -> Maybe Element
    getShapeByPlaceHolderTypes NameSpaces
    ns Element
    spTree [PHType]
    phTypes = do
          let hdrPara :: Paragraph
    hdrPara = ParaProps -> [ParaElem] -> Paragraph
    Paragraph ParaProps
    forall a. Default a => a
    def [ParaElem]
    paraElements
          Element
    element <- Paragraph -> P m Element
    forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
    paragraphToElement Paragraph
    hdrPara
          let txBody :: Element
    txBody = FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:txBody" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                       [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:bodyPr" [] (), FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <>
                       [Element
    element]
          Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ NameSpaces
    -> FilePath -> FilePath -> [Element] -> Element -> Element
    replaceNamedChildren NameSpaces
    ns "p" "txBody" [Element
    txBody] Element
    sp
      -- XXX: TODO
      | Bool
    otherwise = Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sp" [] ()

    contentToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> P m Element
    contentToElement :: Element -> [ParaElem] -> [Shape] -> P m Element
    contentToElement layout :: Element
    layout hdrShape :: [ParaElem]
    hdrShape shapes :: [Shape]
    shapes
      | NameSpaces
    ns <- Element -> NameSpaces
    elemToNameSpaces Element
    layout
      , Just cSld :: Element
    cSld <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "cSld") Element
    layout
      , Just spTree :: Element
    spTree <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "spTree") Element
    cSld = do
          Element
    element <- Element -> [PHType] -> [ParaElem] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m Element
    nonBodyTextToElement Element
    layout [MimeType -> PHType
    PHType "title"] [ParaElem]
    hdrShape
          let hdrShapeElements :: [Element]
    hdrShapeElements = [Element
    element | Bool -> Bool
    not ([ParaElem] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape)]
          [Element]
    contentElements <- (WriterEnv -> WriterEnv)
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local
                             (\env :: WriterEnv
    env -> WriterEnv
    env {envContentType :: ContentType
    envContentType = ContentType
    NormalContent})
                             (Element
    -> [Shape] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [Shape] -> P m [Element]
    shapesToElements Element
    layout [Shape]
    shapes)
          Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ NameSpaces -> Element -> [Element] -> Element
    buildSpTree NameSpaces
    ns Element
    spTree ([Element]
    hdrShapeElements [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    contentElements)
    contentToElement _ _ _ = Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sp" [] ()

    twoColumnToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element
    twoColumnToElement :: Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element
    twoColumnToElement layout :: Element
    layout hdrShape :: [ParaElem]
    hdrShape shapesL :: [Shape]
    shapesL shapesR :: [Shape]
    shapesR
      | NameSpaces
    ns <- Element -> NameSpaces
    elemToNameSpaces Element
    layout
      , Just cSld :: Element
    cSld <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "cSld") Element
    layout
      , Just spTree :: Element
    spTree <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "spTree") Element
    cSld = do
          Element
    element <- Element -> [PHType] -> [ParaElem] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m Element
    nonBodyTextToElement Element
    layout [MimeType -> PHType
    PHType "title"] [ParaElem]
    hdrShape
          let hdrShapeElements :: [Element]
    hdrShapeElements = [Element
    element | Bool -> Bool
    not ([ParaElem] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape)]
          [Element]
    contentElementsL <- (WriterEnv -> WriterEnv)
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local
                              (\env :: WriterEnv
    env -> WriterEnv
    env {envContentType :: ContentType
    envContentType =ContentType
    TwoColumnLeftContent})
                              (Element
    -> [Shape] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [Shape] -> P m [Element]
    shapesToElements Element
    layout [Shape]
    shapesL)
          [Element]
    contentElementsR <- (WriterEnv -> WriterEnv)
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local
                              (\env :: WriterEnv
    env -> WriterEnv
    env {envContentType :: ContentType
    envContentType =ContentType
    TwoColumnRightContent})
                              (Element
    -> [Shape] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [Shape] -> P m [Element]
    shapesToElements Element
    layout [Shape]
    shapesR)
          -- let contentElementsL' = map (setIdx ns "1") contentElementsL
          --     contentElementsR' = map (setIdx ns "2") contentElementsR
          Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ NameSpaces -> Element -> [Element] -> Element
    buildSpTree NameSpaces
    ns Element
    spTree ([Element]
    hdrShapeElements [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    contentElementsL [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    contentElementsR)
    twoColumnToElement _ _ _ _= Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sp" [] ()

    titleToElement :: PandocMonad m => Element -> [ParaElem] -> P m Element
    titleToElement :: Element -> [ParaElem] -> P m Element
    titleToElement layout :: Element
    layout titleElems :: [ParaElem]
    titleElems
      | NameSpaces
    ns <- Element -> NameSpaces
    elemToNameSpaces Element
    layout
      , Just cSld :: Element
    cSld <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "cSld") Element
    layout
      , Just spTree :: Element
    spTree <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "spTree") Element
    cSld = do
          Element
    element <- Element -> [PHType] -> [ParaElem] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m Element
    nonBodyTextToElement Element
    layout [MimeType -> PHType
    PHType "title", MimeType -> PHType
    PHType "ctrTitle"] [ParaElem]
    titleElems
          let titleShapeElements :: [Element]
    titleShapeElements = [Element
    element | Bool -> Bool
    not ([ParaElem] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    titleElems)]
          Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ NameSpaces -> Element -> [Element] -> Element
    buildSpTree NameSpaces
    ns Element
    spTree [Element]
    titleShapeElements
    titleToElement _ _ = Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sp" [] ()

    metadataToElement :: PandocMonad m => Element -> [ParaElem] -> [ParaElem] -> [[ParaElem]] -> [ParaElem] -> P m Element
    metadataToElement :: Element
    -> [ParaElem]
    -> [ParaElem]
    -> [[ParaElem]]
    -> [ParaElem]
    -> P m Element
    metadataToElement layout :: Element
    layout titleElems :: [ParaElem]
    titleElems subtitleElems :: [ParaElem]
    subtitleElems authorsElems :: [[ParaElem]]
    authorsElems dateElems :: [ParaElem]
    dateElems
      | NameSpaces
    ns <- Element -> NameSpaces
    elemToNameSpaces Element
    layout
      , Just cSld :: Element
    cSld <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "cSld") Element
    layout
      , Just spTree :: Element
    spTree <- QName -> Element -> Maybe Element
    findChild (NameSpaces -> FilePath -> FilePath -> QName
    elemName NameSpaces
    ns "p" "spTree") Element
    cSld = do
          [Element]
    titleShapeElements <- if [ParaElem] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    titleElems
                                then [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                                else [P m Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [Element -> [PHType] -> [ParaElem] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m Element
    nonBodyTextToElement Element
    layout [MimeType -> PHType
    PHType "ctrTitle"] [ParaElem]
    titleElems]
          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]
    subtitleElems, [ParaElem]
    combinedAuthorElems]
          [Element]
    subtitleShapeElements <- if [ParaElem] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    subtitleAndAuthorElems
                                   then [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                                   else [P m Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [Element -> [PHType] -> [ParaElem] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m Element
    nonBodyTextToElement Element
    layout [MimeType -> PHType
    PHType "subTitle"] [ParaElem]
    subtitleAndAuthorElems]
          [Element]
    dateShapeElements <- if [ParaElem] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    dateElems
                               then [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                               else [P m Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [Element -> [PHType] -> [ParaElem] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m Element
    nonBodyTextToElement Element
    layout [MimeType -> PHType
    PHType "dt"] [ParaElem]
    dateElems]
          Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ NameSpaces -> Element -> [Element] -> Element
    buildSpTree NameSpaces
    ns Element
    spTree ([Element]
    titleShapeElements [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    subtitleShapeElements [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    dateShapeElements)
    metadataToElement _ _ _ _ _ = Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sp" [] ()

    slideToElement :: PandocMonad m => Slide -> P m Element
    slideToElement :: Slide -> P m Element
    slideToElement (Slide _ l :: Layout
    l@(ContentSlide hdrElems :: [ParaElem]
    hdrElems shapes :: [Shape]
    shapes) _ )= do
      Element
    layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      Element
    spTree <- (WriterEnv -> WriterEnv) -> P m Element -> P m Element
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> if [ParaElem] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrElems
                               then WriterEnv
    env
                               else WriterEnv
    env{envSlideHasHeader :: Bool
    envSlideHasHeader=Bool
    True}) (P m Element -> P m Element) -> P m Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $
                Element -> [ParaElem] -> [Shape] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [ParaElem] -> [Shape] -> P m Element
    contentToElement Element
    layout [ParaElem]
    hdrElems [Shape]
    shapes
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    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")
        ] [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cSld" [] [Element
    spTree]]
    slideToElement (Slide _ l :: Layout
    l@(TwoColumnSlide hdrElems :: [ParaElem]
    hdrElems shapesL :: [Shape]
    shapesL shapesR :: [Shape]
    shapesR) _) = do
      Element
    layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      Element
    spTree <- (WriterEnv -> WriterEnv) -> P m Element -> P m Element
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> if [ParaElem] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrElems
                               then WriterEnv
    env
                               else WriterEnv
    env{envSlideHasHeader :: Bool
    envSlideHasHeader=Bool
    True}) (P m Element -> P m Element) -> P m Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $
                Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element
    twoColumnToElement Element
    layout [ParaElem]
    hdrElems [Shape]
    shapesL [Shape]
    shapesR
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    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")
        ] [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cSld" [] [Element
    spTree]]
    slideToElement (Slide _ l :: Layout
    l@(TitleSlide hdrElems :: [ParaElem]
    hdrElems) _) = do
      Element
    layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      Element
    spTree <- Element -> [ParaElem] -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [ParaElem] -> P m Element
    titleToElement Element
    layout [ParaElem]
    hdrElems
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    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")
        ] [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cSld" [] [Element
    spTree]]
    slideToElement (Slide _ l :: Layout
    l@(MetadataSlide titleElems :: [ParaElem]
    titleElems subtitleElems :: [ParaElem]
    subtitleElems authorElems :: [[ParaElem]]
    authorElems dateElems :: [ParaElem]
    dateElems) _) = do
      Element
    layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      Element
    spTree <- Element
    -> [ParaElem]
    -> [ParaElem]
    -> [[ParaElem]]
    -> [ParaElem]
    -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Element
    -> [ParaElem]
    -> [ParaElem]
    -> [[ParaElem]]
    -> [ParaElem]
    -> P m Element
    metadataToElement Element
    layout [ParaElem]
    titleElems [ParaElem]
    subtitleElems [[ParaElem]]
    authorElems [ParaElem]
    dateElems
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    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")
        ] [FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cSld" [] [Element
    spTree]]

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

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

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

    speakerNotesSlideImage :: Element
    speakerNotesSlideImage :: Element
    speakerNotesSlideImage =
      FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sp" []
      [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:nvSpPr" []
        [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cNvPr" [ ("id", "2")
                           , ("name", "Slide Image Placeholder 1")
                           ] ()
        , FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cNvSpPr" []
          [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:spLocks" [ ("noGrp", "1")
                               , ("noRot", "1")
                               , ("noChangeAspect", "1")
                               ] ()
          ]
        , FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:nvPr" []
          [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:ph" [("type", "sldImg")] ()]
        ]
      , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "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
    paragraph{paraElems :: [ParaElem]
    paraElems = (ParaElem -> ParaElem) -> [ParaElem] -> [ParaElem]
    forall a b. (a -> b) -> [a] -> [b]
    map ParaElem -> ParaElem
    f (Paragraph -> [ParaElem]
    paraElems Paragraph
    paragraph)}
      where f :: ParaElem -> ParaElem
    f (Run rProps :: RunProps
    rProps s :: MimeType
    s) = RunProps -> MimeType -> ParaElem
    Run RunProps
    rProps{rLink :: Maybe LinkTarget
    rLink=Maybe LinkTarget
    forall a. Maybe a
    Nothing} MimeType
    s
            f pe :: 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 :: [Paragraph] -> P m Element
    speakerNotesBody paras :: [Paragraph]
    paras = do
      [Element]
    elements <- (Paragraph -> P 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)
    mapM Paragraph -> P 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 :: Element
    txBody = FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:txBody" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                   [FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:bodyPr" [] (), FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    elements
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $
        FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sp" []
        [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:nvSpPr" []
          [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cNvPr" [ ("id", "3")
                             , ("name", "Notes Placeholder 2")
                             ] ()
          , FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cNvSpPr" []
            [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:spLocks" [("noGrp", "1")] ()]
          , FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:nvPr" []
            [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:ph" [("type", "body"), ("idx", "1")] ()]
          ]
        , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:spPr" [] ()
        , Element
    txBody
        ]

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

    slideToSpeakerNotesElement :: PandocMonad m => Slide -> P m (Maybe Element)
    slideToSpeakerNotesElement :: Slide -> P m (Maybe Element)
    slideToSpeakerNotesElement (Slide _ _ (SpeakerNotes [])) = Maybe Element -> P m (Maybe Element)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Element
    forall a. Maybe a
    Nothing
    slideToSpeakerNotesElement slide :: Slide
    slide@(Slide _ _ (SpeakerNotes paras :: [Paragraph]
    paras)) = do
      Element
    master <- P m Element
    forall (m :: * -> *). PandocMonad m => P m Element
    getNotesMaster
      MimeType
    fieldId  <- Element -> P m MimeType
    forall (m :: * -> *). PandocMonad m => Element -> P m MimeType
    getSlideNumberFieldId Element
    master
      Int
    num <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      let imgShape :: Element
    imgShape = Element
    speakerNotesSlideImage
          sldNumShape :: Element
    sldNumShape = Int -> MimeType -> Element
    speakerNotesSlideNumber Int
    num MimeType
    fieldId
      Element
    bodyShape <- [Paragraph] -> P m Element
    forall (m :: * -> *). PandocMonad m => [Paragraph] -> P m Element
    speakerNotesBody [Paragraph]
    paras
      Maybe Element -> P m (Maybe Element)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Element -> P m (Maybe Element))
    -> Maybe Element -> P m (Maybe Element)
    forall a b. (a -> b) -> a -> b
    $ Element -> Maybe Element
    forall a. a -> Maybe a
    Just (Element -> Maybe Element) -> Element -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $
        FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    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")
        ] [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cSld" []
            [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:spTree" []
              [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:nvGrpSpPr" []
                [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cNvPr" [("id", "1"), ("name", "")] ()
                , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:cNvGrpSpPr" [] ()
                , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:nvPr" [] ()
                ]
              , FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:grpSpPr" []
                [ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:xfrm" []
                  [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:off" [("x", "0"), ("y", "0")] ()
                  , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:ext" [("cx", "0"), ("cy", "0")] ()
                  , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:chOff" [("x", "0"), ("y", "0")] ()
                  , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "a:chExt" [("cx", "0"), ("cy", "0")] ()
                  ]
                ]
              , Element
    imgShape
              , Element
    bodyShape
              , Element
    sldNumShape
              ]
            ]
          ]

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

    getSlideIdNum :: PandocMonad m => SlideId -> P m Int
    getSlideIdNum :: SlideId -> P m Int
    getSlideIdNum sldId :: SlideId
    sldId = do
      Map SlideId Int
    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  SlideId -> Map SlideId Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup SlideId
    sldId Map SlideId Int
    slideIdMap of
        Just n :: Int
    n -> Int -> P m Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    n
        Nothing -> PandocError -> P m Int
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> P m Int) -> PandocError -> P m Int
    forall a b. (a -> b) -> a -> b
    $
                   MimeType -> PandocError
    PandocShouldNeverHappenError (MimeType -> PandocError) -> MimeType -> PandocError
    forall a b. (a -> b) -> a -> b
    $
                   "Slide Id " MimeType -> MimeType -> MimeType
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> MimeType
    T.pack (SlideId -> FilePath
    forall a. Show a => a -> FilePath
    show SlideId
    sldId) MimeType -> MimeType -> MimeType
    forall a. Semigroup a => a -> a -> a
    <> " not found."

    slideNum :: PandocMonad m => Slide -> P m Int
    slideNum :: Slide -> P m Int
    slideNum slide :: 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 idNum :: Int
    idNum = "slide" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    idNum FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ".xml"

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

    slideToRelId :: PandocMonad m => Slide -> P m T.Text
    slideToRelId :: Slide -> P m MimeType
    slideToRelId slide :: Slide
    slide = do
      Int
    n <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      Int
    offset <- (WriterEnv -> Int) -> P m Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Int
    envSlideIdOffset
      MimeType -> P m MimeType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MimeType -> P m MimeType) -> MimeType -> P m MimeType
    forall a b. (a -> b) -> a -> b
    $ "rId" MimeType -> MimeType -> MimeType
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> MimeType
    T.pack (Int -> FilePath
    forall a. Show a => a -> FilePath
    show (Int -> FilePath) -> Int -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    offset)

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

    elementToRel :: Element -> Maybe Relationship
    elementToRel :: Element -> Maybe Relationship
    elementToRel element :: Element
    element
      | Element -> QName
    elName Element
    element QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "Relationship" (FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just "http://schemas.openxmlformats.org/package/2006/relationships") Maybe FilePath
    forall a. Maybe a
    Nothing =
          do FilePath
    rId <- QName -> Element -> Maybe FilePath
    findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "Id" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    element
             FilePath
    numStr <- FilePath -> FilePath -> Maybe FilePath
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix "rId" FilePath
    rId
             Int
    num <- case ReadS Int
    forall a. Read a => ReadS a
    reads FilePath
    numStr :: [(Int, String)] of
               (n :: Int
    n, _) : _ -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n
               []         -> Maybe Int
    forall a. Maybe a
    Nothing
             MimeType
    type' <- QName -> Element -> Maybe MimeType
    findAttrText (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "Type" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    element
             FilePath
    target <- QName -> Element -> Maybe FilePath
    findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
    QName "Target" Maybe FilePath
    forall a. Maybe a
    Nothing Maybe FilePath
    forall a. Maybe a
    Nothing) Element
    element
             Relationship -> Maybe Relationship
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Relationship -> Maybe Relationship)
    -> Relationship -> Maybe Relationship
    forall a b. (a -> b) -> a -> b
    $ Int -> MimeType -> FilePath -> Relationship
    Relationship Int
    num MimeType
    type' FilePath
    target
      | Bool
    otherwise = Maybe Relationship
    forall a. Maybe a
    Nothing

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

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

    presentationToRels :: PandocMonad m => Presentation -> P m [Relationship]
    presentationToRels :: Presentation -> P m [Relationship]
    presentationToRels pres :: Presentation
    pres@(Presentation _ slides :: [Slide]
    slides) = do
      [Relationship]
    mySlideRels <- (Slide -> ReaderT WriterEnv (StateT WriterState m) Relationship)
    -> [Slide] -> P m [Relationship]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Slide -> ReaderT WriterEnv (StateT WriterState m) Relationship
    forall (m :: * -> *). PandocMonad m => Slide -> P m Relationship
    slideToPresRel [Slide]
    slides
      let notesMasterRels :: [Relationship]
    notesMasterRels =
            [Relationship :: Int -> MimeType -> FilePath -> Relationship
    Relationship { relId :: Int
    relId = [Relationship] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Relationship]
    mySlideRels Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 2
                             , relType :: MimeType
    relType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster"
                             , relTarget :: FilePath
    relTarget = "notesMasters/notesMaster1.xml"
                             } | Presentation -> Bool
    presHasSpeakerNotes Presentation
    pres]
          insertedRels :: [Relationship]
    insertedRels = [Relationship]
    mySlideRels [Relationship] -> [Relationship] -> [Relationship]
    forall a. Semigroup a => a -> a -> a
    <> [Relationship]
    notesMasterRels
      [Relationship]
    rels <- P m [Relationship]
    forall (m :: * -> *). PandocMonad m => P m [Relationship]
    getRels
      -- we remove the slide rels and the notesmaster (if it's
      -- there). We'll put these back in ourselves, if necessary.
      let relsWeKeep :: [Relationship]
    relsWeKeep = (Relationship -> Bool) -> [Relationship] -> [Relationship]
    forall a. (a -> Bool) -> [a] -> [a]
    filter
                       (\r :: Relationship
    r -> Relationship -> MimeType
    relType Relationship
    r MimeType -> MimeType -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide" Bool -> Bool -> Bool
    &&
                              Relationship -> MimeType
    relType Relationship
    r MimeType -> MimeType -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
                       [Relationship]
    rels
      -- We want to make room for the slides in the id space. The slides
      -- will start at Id2 (since Id1 is for the slide master). There are
      -- two slides in the data file, but that might change in the future,
      -- so we will do this:
      --
      -- 1. We look to see what the minimum relWithoutSlide id (greater than 1) is.
      -- 2. We add the difference between this and the number of slides to
      -- all relWithoutSlide rels (unless they're 1)
      -- 3. If we have a notesmaster slide, we make space for that as well.

      let minRelNotOne :: Int
    minRelNotOne = case (Int -> Bool) -> [Int] -> [Int]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (1Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <) ([Int] -> [Int]) -> [Int] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ (Relationship -> Int) -> [Relationship] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Relationship -> Int
    relId [Relationship]
    relsWeKeep of
            [] -> 0                 -- doesn't matter in this case, since
                                    -- there will be nothing to map the
                                    -- function over
            l :: [Int]
    l  -> [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum [Int]
    l

          modifyRelNum :: Int -> Int
          modifyRelNum :: Int -> Int
    modifyRelNum 1 = 1
          modifyRelNum n :: Int
    n = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    minRelNotOne Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Relationship] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Relationship]
    insertedRels

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

      [Relationship] -> P m [Relationship]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Relationship] -> P m [Relationship])
    -> [Relationship] -> P m [Relationship]
    forall a b. (a -> b) -> a -> b
    $ [Relationship]
    insertedRels [Relationship] -> [Relationship] -> [Relationship]
    forall a. Semigroup a => a -> a -> a
    <> [Relationship]
    relsWeKeep'

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

    topLevelRelsEntry :: PandocMonad m => P m Entry
    topLevelRelsEntry :: P m Entry
    topLevelRelsEntry = FilePath -> Element -> P m Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry "_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 rel :: Relationship
    rel = FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Relationship" [ ("Id", "rId" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
        Int -> FilePath
    forall a. Show a => a -> FilePath
    show (Relationship -> Int
    relId Relationship
    rel))
                                             , ("Type", MimeType -> FilePath
    T.unpack (MimeType -> FilePath) -> MimeType -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Relationship -> MimeType
    relType Relationship
    rel)
                                             , ("Target", Relationship -> FilePath
    relTarget Relationship
    rel) ] ()

    relsToElement :: [Relationship] -> Element
    relsToElement :: [Relationship] -> Element
    relsToElement rels :: [Relationship]
    rels = FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Relationships"
                         [("xmlns", "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 Entry
    presentationToRelsEntry :: Presentation -> P m Entry
    presentationToRelsEntry pres :: Presentation
    pres = do
      [Relationship]
    rels <- Presentation -> P m [Relationship]
    forall (m :: * -> *).
    PandocMonad m =>
    Presentation -> P m [Relationship]
    presentationToRels Presentation
    pres
      FilePath -> Element -> P m Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry "ppt/_rels/presentation.xml.rels" (Element -> P m Entry) -> Element -> P m Entry
    forall a b. (a -> b) -> a -> b
    $ [Relationship] -> Element
    relsToElement [Relationship]
    rels

    elemToEntry :: PandocMonad m => FilePath -> Element -> P m Entry
    elemToEntry :: FilePath -> Element -> P m Entry
    elemToEntry fp :: FilePath
    fp element :: Element
    element = do
      Pixels
    epochtime <- (POSIXTime -> Pixels
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (POSIXTime -> Pixels)
    -> (UTCTime -> POSIXTime) -> UTCTime -> Pixels
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> POSIXTime
    utcTimeToPOSIXSeconds) (UTCTime -> Pixels)
    -> ReaderT WriterEnv (StateT WriterState m) UTCTime
    -> ReaderT WriterEnv (StateT WriterState m) Pixels
    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
      Entry -> P m Entry
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Entry -> P m Entry) -> Entry -> P m Entry
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Pixels -> ByteString -> Entry
    toEntry FilePath
    fp Pixels
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    element

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

    slideToSpeakerNotesEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
    slideToSpeakerNotesEntry :: Slide -> P m (Maybe Entry)
    slideToSpeakerNotesEntry slide :: Slide
    slide = do
      Int
    idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      (WriterEnv -> WriterEnv) -> P m (Maybe Entry) -> P m (Maybe Entry)
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> WriterEnv
    env{envCurSlideId :: Int
    envCurSlideId = Int
    idNum}) (P m (Maybe Entry) -> P m (Maybe Entry))
    -> P m (Maybe Entry) -> P m (Maybe Entry)
    forall a b. (a -> b) -> a -> b
    $ do
        Maybe Element
    mbElement <- Slide -> P m (Maybe Element)
    forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
    slideToSpeakerNotesElement Slide
    slide
        Maybe Int
    mbNotesIdNum <- do Map Int Int
    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
                           Maybe Int -> ReaderT WriterEnv (StateT WriterState m) (Maybe Int)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Int -> ReaderT WriterEnv (StateT WriterState m) (Maybe Int))
    -> Maybe Int
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ 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 Maybe Element
    mbElement of
          Just element :: Element
    element | Just notesIdNum :: Int
    notesIdNum <- Maybe Int
    mbNotesIdNum ->
                           Entry -> Maybe Entry
    forall a. a -> Maybe a
    Just (Entry -> Maybe Entry)
    -> ReaderT WriterEnv (StateT WriterState m) Entry
    -> P 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
                           ("ppt/notesSlides/notesSlide" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    notesIdNum FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ".xml")
                           Element
    element
          _ -> Maybe Entry -> P m (Maybe Entry)
    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 :: Slide -> P m (Maybe Element)
    slideToSpeakerNotesRelElement (Slide _ _ (SpeakerNotes [])) = Maybe Element -> P m (Maybe Element)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Element
    forall a. Maybe a
    Nothing
    slideToSpeakerNotesRelElement slide :: Slide
    slide@(
      Slide{}) = do
      Int
    idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      Maybe Element -> P m (Maybe Element)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Element -> P m (Maybe Element))
    -> Maybe Element -> P m (Maybe Element)
    forall a b. (a -> b) -> a -> b
    $ Element -> Maybe Element
    forall a. a -> Maybe a
    Just (Element -> Maybe Element) -> Element -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $
        FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Relationships"
        [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
        [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Relationship" [ ("Id", "rId2")
                                , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
                                , ("Target", "../slides/slide" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    idNum FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ".xml")
                                ] ()
        , FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    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 :: Slide -> P m (Maybe Entry)
    slideToSpeakerNotesRelEntry slide :: Slide
    slide = do
      Int
    idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      Maybe Element
    mbElement <- Slide -> P m (Maybe Element)
    forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
    slideToSpeakerNotesRelElement Slide
    slide
      Map Int Int
    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 mbNotesIdNum :: Maybe Int
    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 Maybe Element
    mbElement of
        Just element :: Element
    element | Just notesIdNum :: Int
    notesIdNum <- Maybe Int
    mbNotesIdNum ->
          Entry -> Maybe Entry
    forall a. a -> Maybe a
    Just (Entry -> Maybe Entry)
    -> ReaderT WriterEnv (StateT WriterState m) Entry
    -> P 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
          ("ppt/notesSlides/_rels/notesSlide" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    notesIdNum FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ".xml.rels")
          Element
    element
        _ -> Maybe Entry -> P m (Maybe Entry)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Entry
    forall a. Maybe a
    Nothing

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

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

    linkRelElements :: PandocMonad m => M.Map Int LinkTarget -> P m [Element]
    linkRelElements :: Map Int LinkTarget -> P m [Element]
    linkRelElements mp :: Map Int LinkTarget
    mp = ((Int, LinkTarget)
     -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> [(Int, LinkTarget)] -> P m [Element]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t 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 mInfo :: MediaInfo
    mInfo =
      let ext :: MimeType
    ext = MimeType -> Maybe MimeType -> MimeType
    forall a. a -> Maybe a -> a
    fromMaybe "" (MediaInfo -> Maybe MimeType
    mInfoExt MediaInfo
    mInfo)
      in
        FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Relationship" [ ("Id", "rId" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
          Int -> FilePath
    forall a. Show a => a -> FilePath
    show (MediaInfo -> Int
    mInfoLocalId MediaInfo
    mInfo))
                              , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image")
                              , ("Target", "../media/image" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
          Int -> FilePath
    forall a. Show a => a -> FilePath
    show (MediaInfo -> Int
    mInfoGlobalId MediaInfo
    mInfo) FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> MimeType -> FilePath
    T.unpack MimeType
    ext)
                              ] ()

    speakerNotesSlideRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
    speakerNotesSlideRelElement :: Slide -> P m (Maybe Element)
    speakerNotesSlideRelElement slide :: Slide
    slide = do
      Int
    idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      Map Int Int
    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
      Maybe Element -> P m (Maybe Element)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Element -> P m (Maybe Element))
    -> Maybe Element -> P m (Maybe Element)
    forall a b. (a -> b) -> a -> b
    $ case 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 of
        Nothing -> Maybe Element
    forall a. Maybe a
    Nothing
        Just n :: Int
    n ->
          let target :: FilePath
    target = "../notesSlides/notesSlide" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ".xml"
          in Element -> Maybe Element
    forall a. a -> Maybe a
    Just (Element -> Maybe Element) -> Element -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $
             FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Relationship" [ ("Id", "rId2")
                                   , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesSlide")
                                   , ("Target", FilePath
    target)
                                   ] ()

    slideToSlideRelElement :: PandocMonad m => Slide -> P m Element
    slideToSlideRelElement :: Slide -> P m Element
    slideToSlideRelElement slide :: Slide
    slide = do
      Int
    idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      let target :: FilePath
    target =  case Slide
    slide of
            (Slide _ (MetadataSlide{}) _) -> "../slideLayouts/slideLayout1.xml"
            (Slide _ (TitleSlide _) _)          -> "../slideLayouts/slideLayout3.xml"
            (Slide _ (ContentSlide _ _) _)      -> "../slideLayouts/slideLayout2.xml"
            (Slide _ (TwoColumnSlide{}) _)  -> "../slideLayouts/slideLayout4.xml"

      [Element]
    speakerNotesRels <- Maybe Element -> [Element]
    forall a. Maybe a -> [a]
    maybeToList (Maybe Element -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Element)
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Slide -> ReaderT WriterEnv (StateT WriterState m) (Maybe Element)
    forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
    speakerNotesSlideRelElement Slide
    slide

      Map Int (Map Int LinkTarget)
    linkIds <- (WriterState -> Map Int (Map Int LinkTarget))
    -> ReaderT
         WriterEnv (StateT WriterState m) (Map Int (Map Int LinkTarget))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Map Int (Map Int LinkTarget)
    stLinkIds
      Map Int [MediaInfo]
    mediaIds <- (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

      [Element]
    linkRels <- 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
    idNum Map Int (Map Int LinkTarget)
    linkIds of
                    Just mp :: 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
                    Nothing -> [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      let mediaRels :: [Element]
    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 mInfos :: [MediaInfo]
    mInfos -> (MediaInfo -> Element) -> [MediaInfo] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map MediaInfo -> Element
    mediaRelElement [MediaInfo]
    mInfos
                       Nothing -> []

      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $
        FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Relationships"
        [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
        ([FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Relationship" [ ("Id", "rId1")
                               , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout")
                               , ("Target", FilePath
    target)] ()
        ] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    speakerNotesRels [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    linkRels [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    mediaRels)

    slideToSldIdElement :: PandocMonad m => Slide -> P m Element
    slideToSldIdElement :: Slide -> P m Element
    slideToSldIdElement slide :: Slide
    slide = do
      Int
    n <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      let id' :: FilePath
    id' = Int -> FilePath
    forall a. Show a => a -> FilePath
    show (Int -> FilePath) -> Int -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 255
      MimeType
    rId <- Slide -> P m MimeType
    forall (m :: * -> *). PandocMonad m => Slide -> P m MimeType
    slideToRelId Slide
    slide
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sldId" [("id", FilePath
    id'), ("r:id", MimeType -> FilePath
    T.unpack MimeType
    rId)] ()

    presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element
    presentationToSldIdLst :: Presentation -> P m Element
    presentationToSldIdLst (Presentation _ slides :: [Slide]
    slides) = do
      [Element]
    ids <- (Slide -> P 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)
    mapM Slide -> P m Element
    forall (m :: * -> *). PandocMonad m => Slide -> P m Element
    slideToSldIdElement [Slide]
    slides
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:sldIdLst" [] [Element]
    ids

    presentationToPresentationElement :: PandocMonad m => Presentation -> P m Element
    presentationToPresentationElement :: Presentation -> P m Element
    presentationToPresentationElement pres :: Presentation
    pres@(Presentation _ slds :: [Slide]
    slds) = do
      Archive
    refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      Archive
    distArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envDistArchive
      Element
    element <- Archive -> Archive -> FilePath -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> FilePath -> m Element
    parseXml Archive
    refArchive Archive
    distArchive "ppt/presentation.xml"
      Element
    sldIdLst <- Presentation -> P m Element
    forall (m :: * -> *). PandocMonad m => Presentation -> P m Element
    presentationToSldIdLst Presentation
    pres

      let modifySldIdLst :: Content -> Content
          modifySldIdLst :: Content -> Content
    modifySldIdLst (Elem e :: Element
    e) = case Element -> QName
    elName Element
    e of
            (QName "sldIdLst" _ _) -> Element -> Content
    Elem Element
    sldIdLst
            _                      -> Element -> Content
    Elem Element
    e
          modifySldIdLst ct :: Content
    ct = Content
    ct

          notesMasterRId :: Int
    notesMasterRId = [Slide] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Slide]
    slds Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 2

          notesMasterElem :: Element
    notesMasterElem =  FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "p:notesMasterIdLst" []
                             [ FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode
                               "p:NotesMasterId"
                               [("r:id", "rId" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show 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' :: Content -> [Content]
    removeUnwantedMaster' (Elem e :: Element
    e) = case Element -> QName
    elName Element
    e of
            (QName "notesMasterIdLst" _ _) -> []
            (QName "handoutMasterIdLst" _ _) -> []
            _                              -> [Element -> Content
    Elem Element
    e]
          removeUnwantedMaster' ct :: Content
    ct = [Content
    ct]

          removeUnwantedMaster :: [Content] -> [Content]
          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' :: Content -> [Content]
    insertNotesMaster' (Elem e :: Element
    e) = case Element -> QName
    elName Element
    e of
            (QName "sldMasterIdLst" _ _) -> [Element -> Content
    Elem Element
    e, Element -> Content
    Elem Element
    notesMasterElem]
            _                            -> [Element -> Content
    Elem Element
    e]
          insertNotesMaster' ct :: Content
    ct = [Content
    ct]

          insertNotesMaster :: [Content] -> [Content]
          insertNotesMaster :: [Content] -> [Content]
    insertNotesMaster = if Presentation -> Bool
    presHasSpeakerNotes Presentation
    pres
                              then (Content -> [Content]) -> [Content] -> [Content]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Content -> [Content]
    insertNotesMaster'
                              else [Content] -> [Content]
    forall a. a -> a
    id

          newContent :: [Content]
    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) -> [Content] -> [Content]
    forall a b. (a -> b) -> [a] -> [b]
    map Content -> Content
    modifySldIdLst ([Content] -> [Content]) -> [Content] -> [Content]
    forall a b. (a -> b) -> a -> b
    $
                       Element -> [Content]
    elContent Element
    element

      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ Element
    element{elContent :: [Content]
    elContent = [Content]
    newContent}

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

    -- adapted from the Docx writer
    docPropsElement :: PandocMonad m => DocProps -> P m Element
    docPropsElement :: DocProps -> P m Element
    docPropsElement docProps :: DocProps
    docProps = do
      UTCTime
    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 :: MimeType
    keywords = case DocProps -> Maybe [MimeType]
    dcKeywords DocProps
    docProps of
            Just xs :: [MimeType]
    xs -> MimeType -> [MimeType] -> MimeType
    T.intercalate ", " [MimeType]
    xs
            Nothing -> ""
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $
        FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    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")]
        ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
          FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "dc:title" [] (FilePath -> (MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" MimeType -> FilePath
    T.unpack (Maybe MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall a b. (a -> b) -> a -> b
    $ DocProps -> Maybe MimeType
    dcTitle DocProps
    docProps)
        Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    :
          FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "dc:creator" [] (FilePath -> (MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" MimeType -> FilePath
    T.unpack (Maybe MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall a b. (a -> b) -> a -> b
    $ DocProps -> Maybe MimeType
    dcCreator DocProps
    docProps)
        Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    :
          FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "cp:keywords" [] (MimeType -> FilePath
    T.unpack MimeType
    keywords)
        Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : ( [FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "dc:subject" [] (FilePath -> Element) -> FilePath -> Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" MimeType -> FilePath
    T.unpack (Maybe MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall a b. (a -> b) -> a -> b
    $ DocProps -> Maybe MimeType
    dcSubject DocProps
    docProps | Maybe MimeType -> Bool
    forall a. Maybe a -> Bool
    isJust (DocProps -> Maybe MimeType
    dcSubject DocProps
    docProps)])
        [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> ( [FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "dc:description" [] (FilePath -> Element) -> FilePath -> Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" MimeType -> FilePath
    T.unpack (Maybe MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall a b. (a -> b) -> a -> b
    $ DocProps -> Maybe MimeType
    dcDescription DocProps
    docProps | Maybe MimeType -> Bool
    forall a. Maybe a -> Bool
    isJust (DocProps -> Maybe MimeType
    dcDescription DocProps
    docProps)])
        [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> ( [FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "cp:category" [] (FilePath -> Element) -> FilePath -> Element
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" MimeType -> FilePath
    T.unpack (Maybe MimeType -> FilePath) -> Maybe MimeType -> FilePath
    forall a b. (a -> b) -> a -> b
    $ DocProps -> Maybe MimeType
    cpCategory DocProps
    docProps | Maybe MimeType -> Bool
    forall a. Maybe a -> Bool
    isJust (DocProps -> Maybe MimeType
    cpCategory DocProps
    docProps)])
        [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> (\x :: FilePath
    x -> [ FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] FilePath
    x
                 , FilePath -> NameSpaces -> FilePath -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] FilePath
    x
                 ]) (TimeLocale -> FilePath -> UTCTime -> FilePath
    forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
    formatTime TimeLocale
    defaultTimeLocale "%FT%XZ" UTCTime
    utctime)

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

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

    docCustomPropsToEntry :: PandocMonad m => DocProps -> P m Entry
    docCustomPropsToEntry :: DocProps -> P m Entry
    docCustomPropsToEntry docProps :: DocProps
    docProps = DocProps -> P m Element
    forall (m :: * -> *). PandocMonad m => DocProps -> P m Element
    docCustomPropsElement DocProps
    docProps P m Element -> (Element -> P m Entry) -> P m Entry
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                               FilePath -> Element -> P m Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry "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 :: P m Element
    viewPropsElement = do
      Archive
    refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      Archive
    distArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envDistArchive
      Element
    viewPrElement <- Archive -> Archive -> FilePath -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> FilePath -> m Element
    parseXml Archive
    refArchive Archive
    distArchive "ppt/viewProps.xml"
      -- remove  "lastView" if it exists:
      let notLastView :: Text.XML.Light.Attr -> Bool
          notLastView :: Attr -> Bool
    notLastView attr :: Attr
    attr =
              QName -> FilePath
    qName (Attr -> QName
    attrKey Attr
    attr) FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "lastView"
      Element -> P m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $
        Element
    viewPrElement {elAttribs :: [Attr]
    elAttribs = (Attr -> Bool) -> [Attr] -> [Attr]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Attr -> Bool
    notLastView (Element -> [Attr]
    elAttribs Element
    viewPrElement)}

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

    defaultContentTypeToElem :: DefaultContentType -> Element
    defaultContentTypeToElem :: DefaultContentType -> Element
    defaultContentTypeToElem dct :: DefaultContentType
    dct =
      FilePath -> NameSpaces -> () -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Default"
      [("Extension", MimeType -> FilePath
    T.unpack (MimeType -> FilePath) -> MimeType -> FilePath
    forall a b. (a -> b) -> a -> b
    $ DefaultContentType -> MimeType
    defContentTypesExt DefaultContentType
    dct),
        ("ContentType", MimeType -> FilePath
    T.unpack (MimeType -> FilePath) -> MimeType -> FilePath
    forall a b. (a -> b) -> a -> b
    $ DefaultContentType -> MimeType
    defContentTypesType DefaultContentType
    dct)]
      ()

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

    contentTypesToElement :: ContentTypes -> Element
    contentTypesToElement :: ContentTypes -> Element
    contentTypesToElement ct :: ContentTypes
    ct =
      let ns :: FilePath
    ns = "http://schemas.openxmlformats.org/package/2006/content-types"
      in
        FilePath -> NameSpaces -> [Element] -> Element
    forall t. Node t => FilePath -> NameSpaces -> t -> Element
    mknode "Types" [("xmlns", FilePath
    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 -> MimeType
    defContentTypesExt :: T.Text
                               , DefaultContentType -> MimeType
    defContentTypesType:: MimeType
                               }
                             deriving (Int -> DefaultContentType -> ShowS
    [DefaultContentType] -> ShowS
    DefaultContentType -> FilePath
    (Int -> DefaultContentType -> ShowS)
    -> (DefaultContentType -> FilePath)
    -> ([DefaultContentType] -> ShowS)
    -> Show DefaultContentType
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    showList :: [DefaultContentType] -> ShowS
    $cshowList :: [DefaultContentType] -> ShowS
    show :: DefaultContentType -> FilePath
    $cshow :: DefaultContentType -> FilePath
    showsPrec :: Int -> DefaultContentType -> ShowS
    $cshowsPrec :: Int -> DefaultContentType -> ShowS
    Show, DefaultContentType -> DefaultContentType -> Bool
    (DefaultContentType -> DefaultContentType -> Bool)
    -> (DefaultContentType -> DefaultContentType -> Bool)
    -> Eq DefaultContentType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: DefaultContentType -> DefaultContentType -> Bool
    $c/= :: DefaultContentType -> DefaultContentType -> Bool
    == :: DefaultContentType -> DefaultContentType -> Bool
    $c== :: DefaultContentType -> DefaultContentType -> Bool
    Eq)

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

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

    contentTypesToEntry :: PandocMonad m => ContentTypes -> P m Entry
    contentTypesToEntry :: ContentTypes -> P m Entry
    contentTypesToEntry ct :: ContentTypes
    ct = FilePath -> Element -> P m Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry "[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 fp :: FilePath
    fp = FilePath -> MimeType -> OverrideContentType
    OverrideContentType ("/" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    fp) (MimeType -> OverrideContentType)
    -> Maybe MimeType -> Maybe OverrideContentType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> Maybe MimeType
    getContentType FilePath
    fp

    mediaFileContentType :: FilePath -> Maybe DefaultContentType
    mediaFileContentType :: FilePath -> Maybe DefaultContentType
    mediaFileContentType fp :: FilePath
    fp = case ShowS
    takeExtension FilePath
    fp of
      '.' : ext :: 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 :: MimeType -> MimeType -> DefaultContentType
    DefaultContentType { defContentTypesExt :: MimeType
    defContentTypesExt = FilePath -> MimeType
    T.pack FilePath
    ext
                                      , defContentTypesType :: MimeType
    defContentTypesType =
                                          MimeType -> Maybe MimeType -> MimeType
    forall a. a -> Maybe a -> a
    fromMaybe "application/octet-stream" (FilePath -> Maybe MimeType
    getMimeType FilePath
    fp)
                                      }
      _ -> Maybe DefaultContentType
    forall a. Maybe a
    Nothing

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

    getSpeakerNotesFilePaths :: PandocMonad m => P m [FilePath]
    getSpeakerNotesFilePaths :: P m [FilePath]
    getSpeakerNotesFilePaths = do
      Map Int Int
    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 :: [Int]
    notesIdNums = Map Int Int -> [Int]
    forall k a. Map k a -> [a]
    M.elems Map Int Int
    mp
      [FilePath] -> P m [FilePath]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([FilePath] -> P m [FilePath]) -> [FilePath] -> P m [FilePath]
    forall a b. (a -> b) -> a -> b
    $ (Int -> FilePath) -> [Int] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (\n :: Int
    n -> "ppt/notesSlides/notesSlide" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ".xml") [Int]
    notesIdNums

    presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes
    presentationToContentTypes :: Presentation -> P m ContentTypes
    presentationToContentTypes p :: Presentation
    p@(Presentation _ slides :: [Slide]
    slides) = do
      [MediaInfo]
    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
      [FilePath]
    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
      let mediaFps :: [FilePath]
    mediaFps = (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Pattern -> FilePath -> Bool
    match (FilePath -> Pattern
    compile "ppt/media/image*")) [FilePath]
    filePaths
      let defaults :: [DefaultContentType]
    defaults = [ MimeType -> MimeType -> DefaultContentType
    DefaultContentType "xml" "application/xml"
                     , MimeType -> MimeType -> DefaultContentType
    DefaultContentType "rels" "application/vnd.openxmlformats-package.relationships+xml"
                     ]
          mediaDefaults :: [DefaultContentType]
    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

          inheritedOverrides :: [OverrideContentType]
    inheritedOverrides = (FilePath -> Maybe OverrideContentType)
    -> [FilePath] -> [OverrideContentType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FilePath -> Maybe OverrideContentType
    pathToOverride [FilePath]
    filePaths
          createdOverrides :: [OverrideContentType]
    createdOverrides = (FilePath -> Maybe OverrideContentType)
    -> [FilePath] -> [OverrideContentType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FilePath -> Maybe OverrideContentType
    pathToOverride [ "docProps/core.xml"
                                                     , "docProps/custom.xml"
                                                     , "ppt/presentation.xml"
                                                     , "ppt/viewProps.xml"
                                                     ]
      [FilePath]
    relativePaths <- (Slide -> ReaderT WriterEnv (StateT WriterState m) FilePath)
    -> [Slide] -> P m [FilePath]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Slide -> ReaderT WriterEnv (StateT WriterState m) FilePath
    forall (m :: * -> *). PandocMonad m => Slide -> P m FilePath
    slideToFilePath [Slide]
    slides
      let slideOverrides :: [OverrideContentType]
    slideOverrides = (FilePath -> Maybe OverrideContentType)
    -> [FilePath] -> [OverrideContentType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe
                           (\fp :: FilePath
    fp -> FilePath -> Maybe OverrideContentType
    pathToOverride (FilePath -> Maybe OverrideContentType)
    -> FilePath -> Maybe OverrideContentType
    forall a b. (a -> b) -> a -> b
    $ "ppt/slides/" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    fp)
                           [FilePath]
    relativePaths
      [OverrideContentType]
    speakerNotesOverrides <- (FilePath -> Maybe OverrideContentType)
    -> [FilePath] -> [OverrideContentType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FilePath -> Maybe OverrideContentType
    pathToOverride ([FilePath] -> [OverrideContentType])
    -> P m [FilePath]
    -> ReaderT WriterEnv (StateT WriterState m) [OverrideContentType]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> P m [FilePath]
    forall (m :: * -> *). PandocMonad m => P m [FilePath]
    getSpeakerNotesFilePaths
      ContentTypes -> P m ContentTypes
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ContentTypes -> P m ContentTypes)
    -> ContentTypes -> P m ContentTypes
    forall a b. (a -> b) -> a -> b
    $ [DefaultContentType] -> [OverrideContentType] -> ContentTypes
    ContentTypes
        ([DefaultContentType]
    defaults [DefaultContentType]
    -> [DefaultContentType] -> [DefaultContentType]
    forall a. Semigroup a => a -> a -> a
    <> [DefaultContentType]
    mediaDefaults)
        ([OverrideContentType]
    inheritedOverrides [OverrideContentType]
    -> [OverrideContentType] -> [OverrideContentType]
    forall a. Semigroup a => a -> a -> a
    <> [OverrideContentType]
    createdOverrides [OverrideContentType]
    -> [OverrideContentType] -> [OverrideContentType]
    forall a. Semigroup a => a -> a -> a
    <> [OverrideContentType]
    slideOverrides [OverrideContentType]
    -> [OverrideContentType] -> [OverrideContentType]
    forall a. Semigroup a => a -> a -> a
    <> [OverrideContentType]
    speakerNotesOverrides)

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

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

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

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