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

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

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

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

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

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

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

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

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

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

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

data WriterEnv = WriterEnv { WriterEnv -> Archive
envRefArchive :: Archive
                           , WriterEnv -> Archive
envDistArchive :: Archive
                           , WriterEnv -> UTCTime
envUTCTime :: UTCTime
                           , WriterEnv -> WriterOptions
envOpts :: WriterOptions
                           , WriterEnv -> Context Text
envContext :: Context Text
                           , WriterEnv -> (Integer, Integer)
envPresentationSize :: (Integer, Integer)
                           , WriterEnv -> Bool
envSlideHasHeader :: Bool
                           , WriterEnv -> Bool
envInList :: Bool
                           , WriterEnv -> Bool
envInNoteSlide :: Bool
                           , WriterEnv -> Int
envCurSlideId :: Int
                           , WriterEnv -> Placeholder
envPlaceholder :: Placeholder
                           , WriterEnv -> Map SlideId Int
envSlideIdMap :: M.Map SlideId Int
                           -- maps the slide number to the
                           -- corresponding notes id number. If there
                           -- are no notes for a slide, there will be
                           -- no entry in the map for it.
                           , WriterEnv -> Map Int Int
envSpeakerNotesIdMap :: M.Map Int Int
                           , WriterEnv -> Bool
envInSpeakerNotes :: Bool
                           , WriterEnv -> Maybe SlideLayouts
envSlideLayouts :: Maybe SlideLayouts
                           , WriterEnv -> Maybe Indents
envOtherStyleIndents :: Maybe Indents
                           }
                 deriving (Int -> WriterEnv -> ShowS
[WriterEnv] -> ShowS
WriterEnv -> FilePath
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 { envRefArchive :: Archive
envRefArchive = Archive
emptyArchive
                  , envDistArchive :: Archive
envDistArchive = Archive
emptyArchive
                  , envUTCTime :: UTCTime
envUTCTime = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0
                  , envOpts :: WriterOptions
envOpts = forall a. Default a => a
def
                  , envContext :: Context Text
envContext = forall a. Monoid a => a
mempty
                  , envPresentationSize :: (Integer, Integer)
envPresentationSize = (Integer
720, Integer
540)
                  , envSlideHasHeader :: Bool
envSlideHasHeader = Bool
False
                  , envInList :: Bool
envInList = Bool
False
                  , envInNoteSlide :: Bool
envInNoteSlide = Bool
False
                  , envCurSlideId :: Int
envCurSlideId = Int
1
                  , envPlaceholder :: Placeholder
envPlaceholder = PHType -> Int -> Placeholder
Placeholder PHType
ObjType Int
0
                  , envSlideIdMap :: Map SlideId Int
envSlideIdMap = forall a. Monoid a => a
mempty
                  , envSpeakerNotesIdMap :: Map Int Int
envSpeakerNotesIdMap = forall a. Monoid a => a
mempty
                  , envInSpeakerNotes :: Bool
envInSpeakerNotes = Bool
False
                  , envSlideLayouts :: Maybe SlideLayouts
envSlideLayouts = forall a. Maybe a
Nothing
                  , envOtherStyleIndents :: Maybe Indents
envOtherStyleIndents = forall a. Maybe a
Nothing
                  }

type SlideLayouts = SlideLayoutsOf SlideLayout

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

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

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

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

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

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

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

data MediaInfo = MediaInfo { MediaInfo -> FilePath
mInfoFilePath :: FilePath
                           , MediaInfo -> Int
mInfoLocalId  :: Int
                           , MediaInfo -> Int
mInfoGlobalId :: Int
                           , MediaInfo -> Maybe Text
mInfoMimeType :: Maybe MimeType
                           , MediaInfo -> Maybe Text
mInfoExt      :: Maybe T.Text
                           , MediaInfo -> Bool
mInfoCaption  :: Bool
                           } deriving (Int -> MediaInfo -> ShowS
[MediaInfo] -> ShowS
MediaInfo -> FilePath
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
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
                               , WriterState -> Maybe FooterInfo
stFooterInfo :: Maybe FooterInfo
                               } deriving (Int -> WriterState -> ShowS
[WriterState] -> ShowS
WriterState -> FilePath
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
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 { stLinkIds :: Map Int (Map Int LinkTarget)
stLinkIds = forall a. Monoid a => a
mempty
                    , stMediaIds :: Map Int [MediaInfo]
stMediaIds = forall a. Monoid a => a
mempty
                    , stMediaGlobalIds :: Map FilePath Int
stMediaGlobalIds = forall a. Monoid a => a
mempty
                    , stFooterInfo :: Maybe FooterInfo
stFooterInfo = forall a. Maybe a
Nothing
                    }

type P m = ReaderT WriterEnv (StateT WriterState m)

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

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

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

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

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

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

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

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

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

  let archiveFiles :: [FilePath]
archiveFiles = Archive -> [FilePath]
filesInArchive Archive
refArchive forall a. Eq a => [a] -> [a] -> [a]
`union` Archive -> [FilePath]
filesInArchive Archive
distArchive
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Pattern -> FilePath -> Bool
match Pattern
pat) [FilePath]
archiveFiles

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

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

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

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

  Archive
newArch <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
Archive -> FilePath -> P m Archive
copyFileToArchive Archive
emptyArchive [FilePath]
filePaths

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

  Element
master <- forall (m :: * -> *). PandocMonad m => P m Element
getMaster
  Archive
refArchive <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
  Archive
distArchive <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envDistArchive
  Element
presentationElement <- forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> FilePath -> m Element
parseXml Archive
refArchive Archive
distArchive FilePath
"ppt/presentation.xml"
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s ->
    WriterState
s {stFooterInfo :: Maybe FooterInfo
stFooterInfo =
        Maybe Text
-> SlideLayouts -> Element -> Element -> Maybe FooterInfo
getFooterInfo (DocProps -> Maybe Text
dcDate DocProps
docProps) SlideLayouts
slideLayouts Element
master Element
presentationElement
      })

  -- Update the master to make sure it includes any layouts we've just added
  Element
masterRels <- forall (m :: * -> *). PandocMonad m => P m Element
getMasterRels
  let (Element
updatedMasterElem, Element
updatedMasterRelElem) = SlideLayouts -> Element -> Element -> (Element, Element)
updateMasterElems SlideLayouts
slideLayouts Element
master Element
masterRels
  Entry
updatedMasterEntry <- forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
"ppt/slideMasters/slideMaster1.xml" Element
updatedMasterElem
  Entry
updatedMasterRelEntry <- forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
"ppt/slideMasters/_rels/slideMaster1.xml.rels" Element
updatedMasterRelElem

  -- we make a modified ppt/viewProps.xml out of the presentation viewProps
  Entry
viewPropsEntry <- forall (m :: * -> *). PandocMonad m => P m Entry
makeViewPropsEntry
  -- we make a docProps/core.xml entry out of the presentation docprops
  Entry
docPropsEntry <- 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 <- 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 <- forall (m :: * -> *). PandocMonad m => P m Entry
topLevelRelsEntry
  -- presentation entry and rels.
  (PresentationRIdUpdateData
presentationRIdUpdateData, Entry
presRelsEntry) <- forall (m :: * -> *).
PandocMonad m =>
Presentation -> P m (PresentationRIdUpdateData, Entry)
presentationToRelsEntry Presentation
p
  Entry
presEntry <- forall (m :: * -> *).
PandocMonad m =>
PresentationRIdUpdateData -> Presentation -> P m Entry
presentationToPresEntry PresentationRIdUpdateData
presentationRIdUpdateData Presentation
p
  [Entry]
slideEntries <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Slide -> P m Entry
slideToEntry [Slide]
slides
  [Entry]
slideRelEntries <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Slide -> P m Entry
slideToSlideRelEntry [Slide]
slides
  [Entry]
spkNotesEntries <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Entry)
slideToSpeakerNotesEntry [Slide]
slides
  [Entry]
spkNotesRelEntries <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 <- forall (m :: * -> *). PandocMonad m => P m [Entry]
makeMediaEntries
  Entry
contentTypesEntry <- forall (m :: * -> *).
PandocMonad m =>
Presentation -> P m ContentTypes
presentationToContentTypes Presentation
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). PandocMonad m => ContentTypes -> P m Entry
contentTypesToEntry
  -- fold everything into our inherited archive and return it.
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
newArch' forall a b. (a -> b) -> a -> b
$
    [Entry]
slideEntries forall a. Semigroup a => a -> a -> a
<>
    [Entry]
slideRelEntries forall a. Semigroup a => a -> a -> a
<>
    [Entry]
spkNotesEntries forall a. Semigroup a => a -> a -> a
<>
    [Entry]
spkNotesRelEntries forall a. Semigroup a => a -> a -> a
<>
    [Entry]
mediaEntries forall a. Semigroup a => a -> a -> a
<>
    [Entry
updatedMasterEntry, Entry
updatedMasterRelEntry]  forall a. Semigroup a => a -> a -> a
<>
    [Entry
contentTypesEntry, Entry
docPropsEntry, Entry
docCustomPropsEntry, Entry
relsEntry,
     Entry
presEntry, Entry
presRelsEntry, Entry
viewPropsEntry]

updateMasterElems :: SlideLayouts -> Element -> Element -> (Element, Element)
updateMasterElems :: SlideLayouts -> Element -> Element -> (Element, Element)
updateMasterElems SlideLayouts
layouts Element
master Element
masterRels = (Element
updatedMaster, Element
updatedMasterRels)
  where
    updatedMaster :: Element
updatedMaster = Element
master { elContent :: [Content]
elContent = Content -> Content
updateSldLayoutIdLst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> [Content]
elContent Element
master }
    ([Text]
updatedRelationshipIds, Element
updatedMasterRels) = Element -> ([Text], Element)
addLayoutRels Element
masterRels

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

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

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

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

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

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

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

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

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

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

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

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

footerElements ::
  PandocMonad m =>
  (forall a. SlideLayoutsOf a -> a) ->
  P m [Content]
footerElements :: forall (m :: * -> *).
PandocMonad m =>
(forall a. SlideLayoutsOf a -> a) -> P m [Content]
footerElements forall a. SlideLayoutsOf a -> a
layout = do
  Maybe FooterInfo
footerInfo <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe FooterInfo
stFooterInfo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall a b. (a -> b) -> a -> b
$ Element -> Content
Elem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe FooterInfo
footerInfo forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. SlideLayoutsOf a -> a
layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. FooterInfo -> SlideLayoutsOf (Maybe Element)
fiDate)
       forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe FooterInfo
footerInfo forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. SlideLayoutsOf a -> a
layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. FooterInfo -> SlideLayoutsOf (Maybe Element)
fiFooter)
       forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe FooterInfo
footerInfo forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. SlideLayoutsOf a -> a
layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. FooterInfo -> SlideLayoutsOf (Maybe Element)
fiSlideNumber))

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

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

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

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

  Element
master <- forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> m Element
getMaster' Archive
refArchive Archive
distArchive

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

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

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

  -- note, we need writerTemplate to be Just _ or metaToContext does
  -- nothing
  Context Text
context <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate =
                                  WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just forall a. Monoid a => a
mempty }
                (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Walkable Inline a => a -> Text
stringify)
                (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Walkable Inline a => a -> Text
stringify) Meta
meta

  let env :: WriterEnv
env = 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
                , envContext :: Context Text
envContext = Context Text
context
                , envPresentationSize :: (Integer, Integer)
envPresentationSize = (Integer, Integer)
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
                , envSlideLayouts :: Maybe SlideLayouts
envSlideLayouts = forall a. a -> Maybe a
Just SlideLayouts
layouts
                , envOtherStyleIndents :: Maybe Indents
envOtherStyleIndents = Maybe Indents
otherStyleIndents
                }

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

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

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

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

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

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

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

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

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

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

type ShapeId = Integer

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

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

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


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

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

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

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

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

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

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

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

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

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

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


  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stMediaIds :: Map Int [MediaInfo]
stMediaIds = 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
                    }
  forall (m :: * -> *) a. Monad m => a -> m a
return MediaInfo
mediaInfo

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

makeMediaEntries :: PandocMonad m => P m [Entry]
makeMediaEntries :: forall (m :: * -> *). PandocMonad m => P m [Entry]
makeMediaEntries = do
  Map Int [MediaInfo]
mediaInfos <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int [MediaInfo]
stMediaIds
  let allInfos :: [MediaInfo]
allInfos = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map Int [MediaInfo]
mediaInfos
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 :: forall (m :: * -> *). PandocMonad m => P m Element
getMaster = do
  Archive
refArchive <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
  Archive
distArchive <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envDistArchive
  forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> m Element
getMaster' Archive
refArchive Archive
distArchive

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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


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

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

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

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

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

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

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

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

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

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

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

graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element
graphicToElement :: forall (m :: * -> *).
PandocMonad m =>
Integer -> Graphic -> P m Element
graphicToElement Integer
tableWidth (Tbl TableProps
tblPr [[Paragraph]]
hdrCells [[[Paragraph]]]
rows) = do
  let colWidths :: [Integer]
colWidths = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Paragraph]]
hdrCells
                  then case [[[Paragraph]]]
rows of
                         [[Paragraph]]
r : [[[Paragraph]]]
_ | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Paragraph]]
r) -> forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Paragraph]]
r) forall a b. (a -> b) -> a -> b
$
                                                 Integer
tableWidth forall a. Integral a => a -> a -> a
`div` forall a. Integral a => a -> Integer
toInteger (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.
                         [[[Paragraph]]]
_ -> []
                  else forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Paragraph]]
hdrCells) forall a b. (a -> b) -> a -> b
$
                       Integer
tableWidth forall a. Integral a => a -> a -> a
`div` forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Paragraph]]
hdrCells)

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

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

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

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

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:graphic" []
    [forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:graphicData" [(Text
"uri", Text
"http://schemas.openxmlformats.org/drawingml/2006/table")]
     [forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tbl" [] forall a b. (a -> b) -> a -> b
$
      [ Element
tblPrElt
      , forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tblGrid" [] (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Integer
0) [Integer]
colWidths
                               then []
                               else forall a b. (a -> b) -> [a] -> [b]
map Integer -> Element
mkgridcol [Integer]
colWidths)
      ]
      forall a. Semigroup a => a -> a -> a
<> [ Bool -> [[Element]] -> Element
mkrow Bool
True [[Element]]
headers' | Bool
hasHeader ] forall a. Semigroup a => a -> a -> a
<> 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
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
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 :: [(Text, Text)] -> Element -> PHType -> Bool
findPHType [(Text, Text)]
ns Element
spElem PHType
phType
  | [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
"p" Text
"sp" Element
spElem =
    let mbPHElem :: Maybe Element
mbPHElem = (forall a. a -> Maybe a
Just Element
spElem forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                   QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"nvSpPr") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                   QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"nvPr") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                   QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"ph"))
    in
      case Maybe Element
mbPHElem of
        -- if it's a named PHType, we want to check that the attribute
        -- value matches.
        Just Element
phElem | (PHType Text
tp) <- PHType
phType ->
                        case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"type" forall a. Maybe a
Nothing forall a. Maybe a
Nothing) Element
phElem of
                          Just Text
tp' -> Text
tp forall a. Eq a => a -> a -> Bool
== Text
tp'
                          Maybe Text
Nothing -> Bool
False
        -- if it's an ObjType, we want to check that there is NO
        -- "type" attribute. In other words, a lookup should return nothing.
        Just Element
phElem | PHType
ObjType <- PHType
phType ->
                        case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"type" forall a. Maybe a
Nothing forall a. Maybe a
Nothing) Element
phElem of
                          Just Text
_ -> Bool
False
                          Maybe Text
Nothing -> Bool
True
        Maybe Element
Nothing -> Bool
False
findPHType [(Text, Text)]
_ Element
_ PHType
_ = Bool
False

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


data Relationship = Relationship { Relationship -> Int
relId :: Int
                                 , Relationship -> Text
relType :: MimeType
                                 , Relationship -> FilePath
relTarget :: FilePath
                                 } deriving (Int -> Relationship -> ShowS
[Relationship] -> ShowS
Relationship -> FilePath
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
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 -> QName
elName Element
element forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Relationship" (forall a. a -> Maybe a
Just Text
"http://schemas.openxmlformats.org/package/2006/relationships") forall a. Maybe a
Nothing =
      do Text
rId <- QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Id" forall a. Maybe a
Nothing forall a. Maybe a
Nothing) Element
element
         Text
numStr <- Text -> Text -> Maybe Text
T.stripPrefix Text
"rId" Text
rId
         Int
num <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Integer
readTextAsInteger Text
numStr
         Text
type' <- QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Type" forall a. Maybe a
Nothing forall a. Maybe a
Nothing) Element
element
         Text
target <- QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Target" forall a. Maybe a
Nothing forall a. Maybe a
Nothing) Element
element
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Text -> FilePath -> Relationship
Relationship Int
num Text
type' (Text -> FilePath
T.unpack Text
target)
  | Bool
otherwise = forall a. Maybe a
Nothing

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

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

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

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

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

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

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

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

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

  [Relationship]
mySlideRels <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Int -> Slide -> P m Relationship
slideToPresRel Int
slideStartId) [Slide]
slides

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

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

  forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
minOverlappingRel, (Int, Int)
newRIdBounds), [Relationship]
insertedRels 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 { relId :: Int
relId = Int
1
                 , relType :: Text
relType = Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument"
                 , relTarget :: FilePath
relTarget = FilePath
"ppt/presentation.xml"
                 }
  , Relationship { relId :: Int
relId = Int
2
                 , relType :: Text
relType = Text
"http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties"
                 , relTarget :: FilePath
relTarget = FilePath
"docProps/core.xml"
                 }
  , Relationship { relId :: Int
relId = Int
3
                 , relType :: Text
relType = Text
"http://schemas.openxmlformats.org/package/2006/relationships/metadata/extended-properties"
                 , relTarget :: FilePath
relTarget = FilePath
"docProps/app.xml"
                 }
  , Relationship { relId :: Int
relId = Int
4
                 , relType :: Text
relType = Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties"
                 , relTarget :: FilePath
relTarget = FilePath
"docProps/custom.xml"
                 }
  ]

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

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

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

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

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

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

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

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


slideToSpeakerNotesRelEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
slideToSpeakerNotesRelEntry :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Entry)
slideToSpeakerNotesRelEntry Slide
slide = do
  Int
idNum <- forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
  Maybe Element
mbElement <- forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
slideToSpeakerNotesRelElement Slide
slide
  Map Int Int
mp <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Map Int Int
envSpeakerNotesIdMap
  let mbNotesIdNum :: Maybe Int
mbNotesIdNum = 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 | Just Int
notesIdNum <- Maybe Int
mbNotesIdNum ->
      forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry
      (FilePath
"ppt/notesSlides/_rels/notesSlide" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
notesIdNum forall a. Semigroup a => a -> a -> a
<> FilePath
".xml.rels")
      Element
element
    Maybe Element
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

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

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

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

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

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

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

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

  Map Int (Map Int LinkTarget)
linkIds <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int (Map Int LinkTarget)
stLinkIds
  Map Int [MediaInfo]
mediaIds <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int [MediaInfo]
stMediaIds

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

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

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

presentationToSldIdLst ::
  PandocMonad m =>
  MinimumRId ->
  Presentation ->
  P m Element
presentationToSldIdLst :: forall (m :: * -> *).
PandocMonad m =>
Int -> Presentation -> P m Element
presentationToSldIdLst Int
minimumSlideRId (Presentation DocProps
_ [Slide]
slides) = do
  [Element]
ids <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). PandocMonad m => Int -> Slide -> P m Element
slideToSldIdElement Int
minimumSlideRId) [Slide]
slides
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sldIdLst" [] [Element]
ids

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

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

      notesMasterRId :: Int
notesMasterRId = Int
maxSlideRId

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

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

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

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

      insertNotesMaster' :: Content -> [Content]
      insertNotesMaster' :: Content -> [Content]
insertNotesMaster' (Elem Element
e) = case Element -> QName
elName Element
e of
        (QName Text
"sldMasterIdLst" Maybe Text
_ Maybe Text
_) -> [Element -> Content
Elem Element
e, Element -> Content
Elem Element
notesMasterElem]
        QName
_                            -> [Element -> Content
Elem Element
e]
      insertNotesMaster' Content
ct = [Content
ct]

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

      updateRIds :: Content -> Content
      updateRIds :: Content -> Content
updateRIds (Elem Element
el) =
        Element -> Content
Elem (Element
el { elAttribs :: [Attr]
elAttribs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attr -> Attr
updateRIdAttribute (Element -> [Attr]
elAttribs Element
el)
                 , elContent :: [Content]
elContent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Content -> Content
updateRIds (Element -> [Content]
elContent Element
el)
                 })
      updateRIds Content
content = Content
content

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

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

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

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

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

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

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

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

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

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

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

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

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

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

data DefaultContentType = DefaultContentType
                           { DefaultContentType -> Text
defContentTypesExt :: T.Text
                           , DefaultContentType -> Text
defContentTypesType:: MimeType
                           }
                         deriving (Int -> DefaultContentType -> ShowS
[DefaultContentType] -> ShowS
DefaultContentType -> FilePath
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
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 -> Text
overrideContentTypesType :: MimeType
                           }
                          deriving (Int -> OverrideContentType -> ShowS
[OverrideContentType] -> ShowS
OverrideContentType -> FilePath
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
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
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
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 :: forall (m :: * -> *). PandocMonad m => ContentTypes -> P m Entry
contentTypesToEntry ContentTypes
ct = forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
"[Content_Types].xml" forall a b. (a -> b) -> a -> b
$ ContentTypes -> Element
contentTypesToElement ContentTypes
ct

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

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

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

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

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

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

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

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

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

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

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

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

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