{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
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)
type EMU = Integer
pixelsToEmu :: Pixels -> EMU
pixelsToEmu :: Integer -> Integer
pixelsToEmu = (Integer
12700 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*)
initialGlobalIds :: Archive -> Archive -> M.Map FilePath Int
initialGlobalIds :: Archive -> Archive -> Map FilePath Int
initialGlobalIds Archive
refArchive Archive
distArchive =
let archiveFiles :: [FilePath]
archiveFiles = Archive -> [FilePath]
filesInArchive Archive
refArchive [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
`union` Archive -> [FilePath]
filesInArchive Archive
distArchive
mediaPaths :: [FilePath]
mediaPaths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"ppt/media/image") [FilePath]
archiveFiles
go :: FilePath -> Maybe (FilePath, Int)
go :: FilePath -> Maybe (FilePath, Int)
go FilePath
fp = do
s <- FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
"ppt/media/image" (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath) -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath, FilePath)
splitExtension FilePath
fp
(n, _) <- listToMaybe $ reads s
return (fp, n)
in
[(FilePath, Int)] -> Map FilePath Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FilePath, Int)] -> Map FilePath Int)
-> [(FilePath, Int)] -> Map FilePath Int
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe (FilePath, Int))
-> [FilePath] -> [(FilePath, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe (FilePath, Int)
go [FilePath]
mediaPaths
getPresentationSize :: Archive -> Archive -> Maybe (Integer, Integer)
getPresentationSize :: Archive -> Archive -> Maybe (Integer, Integer)
getPresentationSize Archive
refArchive Archive
distArchive = do
entry <- FilePath -> Archive -> Maybe Entry
findEntryByPath FilePath
"ppt/presentation.xml" Archive
refArchive Maybe Entry -> Maybe Entry -> Maybe Entry
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
FilePath -> Archive -> Maybe Entry
findEntryByPath FilePath
"ppt/presentation.xml" Archive
distArchive
presElement <- either (const Nothing) return $
parseXMLElement $ UTF8.toTextLazy $ fromEntry entry
let ns = Element -> [(Text, Text)]
elemToNameSpaces Element
presElement
sldSize <- findChild (elemName ns "p" "sldSz") presElement
cxS <- findAttr (QName "cx" Nothing Nothing) sldSize
cyS <- findAttr (QName "cy" Nothing Nothing) sldSize
cx <- readTextAsInteger cxS
cy <- readTextAsInteger cyS
return (cx `div` 12700, cy `div` 12700)
readTextAsInteger :: Text -> Maybe Integer
readTextAsInteger :: Text -> Maybe Integer
readTextAsInteger = (FilePath -> Maybe Integer)
-> ((Integer, Text) -> Maybe Integer)
-> Either FilePath (Integer, Text)
-> Maybe Integer
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Integer -> FilePath -> Maybe Integer
forall a b. a -> b -> a
const Maybe Integer
forall a. Maybe a
Nothing) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> ((Integer, Text) -> Integer) -> (Integer, Text) -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Text) -> Integer
forall a b. (a, b) -> a
fst) (Either FilePath (Integer, Text) -> Maybe Integer)
-> (Text -> Either FilePath (Integer, Text))
-> Text
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath (Integer, Text)
forall a. Integral a => Reader a
Data.Text.Read.decimal
data WriterEnv = WriterEnv { WriterEnv -> Archive
envRefArchive :: Archive
, WriterEnv -> Archive
envDistArchive :: Archive
, WriterEnv -> UTCTime
envUTCTime :: UTCTime
, WriterEnv -> WriterOptions
envOpts :: WriterOptions
, WriterEnv -> Context Text
envContext :: Context Text
, WriterEnv -> (Integer, Integer)
envPresentationSize :: (Integer, Integer)
, :: 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
, WriterEnv -> Map Int Int
envSpeakerNotesIdMap :: M.Map Int Int
, WriterEnv -> Bool
envInSpeakerNotes :: Bool
, WriterEnv -> Maybe SlideLayouts
envSlideLayouts :: Maybe SlideLayouts
, WriterEnv -> Maybe Indents
envOtherStyleIndents :: Maybe Indents
}
deriving (Int -> WriterEnv -> FilePath -> FilePath
[WriterEnv] -> FilePath -> FilePath
WriterEnv -> FilePath
(Int -> WriterEnv -> FilePath -> FilePath)
-> (WriterEnv -> FilePath)
-> ([WriterEnv] -> FilePath -> FilePath)
-> Show WriterEnv
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> WriterEnv -> FilePath -> FilePath
showsPrec :: Int -> WriterEnv -> FilePath -> FilePath
$cshow :: WriterEnv -> FilePath
show :: WriterEnv -> FilePath
$cshowList :: [WriterEnv] -> FilePath -> FilePath
showList :: [WriterEnv] -> FilePath -> FilePath
Show)
instance Default WriterEnv where
def :: WriterEnv
def = WriterEnv { envRefArchive :: Archive
envRefArchive = Archive
emptyArchive
, envDistArchive :: Archive
envDistArchive = Archive
emptyArchive
, envUTCTime :: UTCTime
envUTCTime = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0
, envOpts :: WriterOptions
envOpts = WriterOptions
forall a. Default a => a
def
, envContext :: Context Text
envContext = Context Text
forall a. Monoid a => a
mempty
, envPresentationSize :: (Integer, Integer)
envPresentationSize = (Integer
720, Integer
540)
, envSlideHasHeader :: Bool
envSlideHasHeader = Bool
False
, envInList :: Bool
envInList = Bool
False
, envInNoteSlide :: Bool
envInNoteSlide = Bool
False
, envCurSlideId :: Int
envCurSlideId = Int
1
, envPlaceholder :: Placeholder
envPlaceholder = PHType -> Int -> Placeholder
Placeholder PHType
ObjType Int
0
, envSlideIdMap :: Map SlideId Int
envSlideIdMap = Map SlideId Int
forall a. Monoid a => a
mempty
, envSpeakerNotesIdMap :: Map Int Int
envSpeakerNotesIdMap = Map Int Int
forall a. Monoid a => a
mempty
, envInSpeakerNotes :: Bool
envInSpeakerNotes = Bool
False
, envSlideLayouts :: Maybe SlideLayouts
envSlideLayouts = Maybe SlideLayouts
forall a. Maybe a
Nothing
, envOtherStyleIndents :: Maybe Indents
envOtherStyleIndents = Maybe Indents
forall a. Maybe a
Nothing
}
type SlideLayouts = SlideLayoutsOf SlideLayout
data SlideLayoutsOf a = SlideLayouts
{ forall a. SlideLayoutsOf a -> a
metadata :: a
, forall a. SlideLayoutsOf a -> a
title :: a
, forall a. SlideLayoutsOf a -> a
content :: a
, forall a. SlideLayoutsOf a -> a
twoColumn :: a
, forall a. SlideLayoutsOf a -> a
comparison :: a
, forall a. SlideLayoutsOf a -> a
contentWithCaption :: a
, forall a. SlideLayoutsOf a -> a
blank :: a
} deriving (Int -> SlideLayoutsOf a -> FilePath -> FilePath
[SlideLayoutsOf a] -> FilePath -> FilePath
SlideLayoutsOf a -> FilePath
(Int -> SlideLayoutsOf a -> FilePath -> FilePath)
-> (SlideLayoutsOf a -> FilePath)
-> ([SlideLayoutsOf a] -> FilePath -> FilePath)
-> Show (SlideLayoutsOf a)
forall a. Show a => Int -> SlideLayoutsOf a -> FilePath -> FilePath
forall a. Show a => [SlideLayoutsOf a] -> FilePath -> FilePath
forall a. Show a => SlideLayoutsOf a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SlideLayoutsOf a -> FilePath -> FilePath
showsPrec :: Int -> SlideLayoutsOf a -> FilePath -> FilePath
$cshow :: forall a. Show a => SlideLayoutsOf a -> FilePath
show :: SlideLayoutsOf a -> FilePath
$cshowList :: forall a. Show a => [SlideLayoutsOf a] -> FilePath -> FilePath
showList :: [SlideLayoutsOf a] -> FilePath -> FilePath
Show, SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
(SlideLayoutsOf a -> SlideLayoutsOf a -> Bool)
-> (SlideLayoutsOf a -> SlideLayoutsOf a -> Bool)
-> Eq (SlideLayoutsOf a)
forall a. Eq a => SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
== :: SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
$c/= :: forall a. Eq a => SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
/= :: SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
Eq, (forall a b. (a -> b) -> SlideLayoutsOf a -> SlideLayoutsOf b)
-> (forall a b. a -> SlideLayoutsOf b -> SlideLayoutsOf a)
-> Functor SlideLayoutsOf
forall a b. a -> SlideLayoutsOf b -> SlideLayoutsOf a
forall a b. (a -> b) -> SlideLayoutsOf a -> SlideLayoutsOf b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SlideLayoutsOf a -> SlideLayoutsOf b
fmap :: forall a b. (a -> b) -> SlideLayoutsOf a -> SlideLayoutsOf b
$c<$ :: forall a b. a -> SlideLayoutsOf b -> SlideLayoutsOf a
<$ :: forall a b. a -> SlideLayoutsOf b -> SlideLayoutsOf a
Functor, (forall m. Monoid m => SlideLayoutsOf m -> m)
-> (forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m)
-> (forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m)
-> (forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b)
-> (forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b)
-> (forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b)
-> (forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b)
-> (forall a. (a -> a -> a) -> SlideLayoutsOf a -> a)
-> (forall a. (a -> a -> a) -> SlideLayoutsOf a -> a)
-> (forall a. SlideLayoutsOf a -> [a])
-> (forall a. SlideLayoutsOf a -> Bool)
-> (forall a. SlideLayoutsOf a -> Int)
-> (forall a. Eq a => a -> SlideLayoutsOf a -> Bool)
-> (forall a. Ord a => SlideLayoutsOf a -> a)
-> (forall a. Ord a => SlideLayoutsOf a -> a)
-> (forall a. Num a => SlideLayoutsOf a -> a)
-> (forall a. Num a => SlideLayoutsOf a -> a)
-> Foldable SlideLayoutsOf
forall a. Eq a => a -> SlideLayoutsOf a -> Bool
forall a. Num a => SlideLayoutsOf a -> a
forall a. Ord a => SlideLayoutsOf a -> a
forall m. Monoid m => SlideLayoutsOf m -> m
forall a. SlideLayoutsOf a -> Bool
forall a. SlideLayoutsOf a -> Int
forall a. SlideLayoutsOf a -> [a]
forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SlideLayoutsOf m -> m
fold :: forall m. Monoid m => SlideLayoutsOf m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
foldr1 :: forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
foldl1 :: forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
$ctoList :: forall a. SlideLayoutsOf a -> [a]
toList :: forall a. SlideLayoutsOf a -> [a]
$cnull :: forall a. SlideLayoutsOf a -> Bool
null :: forall a. SlideLayoutsOf a -> Bool
$clength :: forall a. SlideLayoutsOf a -> Int
length :: forall a. SlideLayoutsOf a -> Int
$celem :: forall a. Eq a => a -> SlideLayoutsOf a -> Bool
elem :: forall a. Eq a => a -> SlideLayoutsOf a -> Bool
$cmaximum :: forall a. Ord a => SlideLayoutsOf a -> a
maximum :: forall a. Ord a => SlideLayoutsOf a -> a
$cminimum :: forall a. Ord a => SlideLayoutsOf a -> a
minimum :: forall a. Ord a => SlideLayoutsOf a -> a
$csum :: forall a. Num a => SlideLayoutsOf a -> a
sum :: forall a. Num a => SlideLayoutsOf a -> a
$cproduct :: forall a. Num a => SlideLayoutsOf a -> a
product :: forall a. Num a => SlideLayoutsOf a -> a
Foldable, Functor SlideLayoutsOf
Foldable SlideLayoutsOf
(Functor SlideLayoutsOf, Foldable SlideLayoutsOf) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SlideLayoutsOf a -> f (SlideLayoutsOf b))
-> (forall (f :: * -> *) a.
Applicative f =>
SlideLayoutsOf (f a) -> f (SlideLayoutsOf a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SlideLayoutsOf a -> m (SlideLayoutsOf b))
-> (forall (m :: * -> *) a.
Monad m =>
SlideLayoutsOf (m a) -> m (SlideLayoutsOf a))
-> Traversable SlideLayoutsOf
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SlideLayoutsOf (m a) -> m (SlideLayoutsOf a)
forall (f :: * -> *) a.
Applicative f =>
SlideLayoutsOf (f a) -> f (SlideLayoutsOf a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SlideLayoutsOf a -> m (SlideLayoutsOf b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SlideLayoutsOf a -> f (SlideLayoutsOf b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SlideLayoutsOf a -> f (SlideLayoutsOf b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SlideLayoutsOf a -> f (SlideLayoutsOf b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SlideLayoutsOf (f a) -> f (SlideLayoutsOf a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SlideLayoutsOf (f a) -> f (SlideLayoutsOf a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SlideLayoutsOf a -> m (SlideLayoutsOf b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SlideLayoutsOf a -> m (SlideLayoutsOf b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SlideLayoutsOf (m a) -> m (SlideLayoutsOf a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SlideLayoutsOf (m a) -> m (SlideLayoutsOf a)
Traversable)
data SlideLayout = SlideLayout
{ SlideLayout -> Element
slElement :: Element
, SlideLayout -> Bool
slInReferenceDoc :: Bool
, SlideLayout -> FilePath
slPath :: FilePath
, SlideLayout -> Entry
slEntry :: Entry
} deriving (Int -> SlideLayout -> FilePath -> FilePath
[SlideLayout] -> FilePath -> FilePath
SlideLayout -> FilePath
(Int -> SlideLayout -> FilePath -> FilePath)
-> (SlideLayout -> FilePath)
-> ([SlideLayout] -> FilePath -> FilePath)
-> Show SlideLayout
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> SlideLayout -> FilePath -> FilePath
showsPrec :: Int -> SlideLayout -> FilePath -> FilePath
$cshow :: SlideLayout -> FilePath
show :: SlideLayout -> FilePath
$cshowList :: [SlideLayout] -> FilePath -> FilePath
showList :: [SlideLayout] -> FilePath -> FilePath
Show)
getSlideLayouts :: PandocMonad m => P m SlideLayouts
getSlideLayouts :: forall (m :: * -> *). PandocMonad m => P m SlideLayouts
getSlideLayouts = (WriterEnv -> Maybe SlideLayouts)
-> ReaderT WriterEnv (StateT WriterState m) (Maybe SlideLayouts)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Maybe SlideLayouts
envSlideLayouts ReaderT WriterEnv (StateT WriterState m) (Maybe SlideLayouts)
-> (Maybe SlideLayouts
-> ReaderT WriterEnv (StateT WriterState m) SlideLayouts)
-> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
forall a b.
ReaderT WriterEnv (StateT WriterState m) a
-> (a -> ReaderT WriterEnv (StateT WriterState m) b)
-> ReaderT WriterEnv (StateT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT WriterEnv (StateT WriterState m) SlideLayouts
-> (SlideLayouts
-> ReaderT WriterEnv (StateT WriterState m) SlideLayouts)
-> Maybe SlideLayouts
-> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PandocError
-> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e) SlideLayouts
-> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
where
e :: PandocError
e = Text -> PandocError
PandocSomeError (Text
"Slide layouts aren't defined, even though they should "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"always be. This is a bug in pandoc.")
data Placeholder = Placeholder
{ Placeholder -> PHType
placeholderType :: PHType
, Placeholder -> Int
index :: Int
} deriving (Int -> Placeholder -> FilePath -> FilePath
[Placeholder] -> FilePath -> FilePath
Placeholder -> FilePath
(Int -> Placeholder -> FilePath -> FilePath)
-> (Placeholder -> FilePath)
-> ([Placeholder] -> FilePath -> FilePath)
-> Show Placeholder
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Placeholder -> FilePath -> FilePath
showsPrec :: Int -> Placeholder -> FilePath -> FilePath
$cshow :: Placeholder -> FilePath
show :: Placeholder -> FilePath
$cshowList :: [Placeholder] -> FilePath -> FilePath
showList :: [Placeholder] -> FilePath -> FilePath
Show, Placeholder -> Placeholder -> Bool
(Placeholder -> Placeholder -> Bool)
-> (Placeholder -> Placeholder -> Bool) -> Eq Placeholder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Placeholder -> Placeholder -> Bool
== :: Placeholder -> Placeholder -> Bool
$c/= :: Placeholder -> Placeholder -> Bool
/= :: Placeholder -> Placeholder -> Bool
Eq)
data Indents = Indents
{ Indents -> Maybe LevelIndents
level1 :: Maybe LevelIndents
, Indents -> Maybe LevelIndents
level2 :: Maybe LevelIndents
, Indents -> Maybe LevelIndents
level3 :: Maybe LevelIndents
, Indents -> Maybe LevelIndents
level4 :: Maybe LevelIndents
, Indents -> Maybe LevelIndents
level5 :: Maybe LevelIndents
, Indents -> Maybe LevelIndents
level6 :: Maybe LevelIndents
, Indents -> Maybe LevelIndents
level7 :: Maybe LevelIndents
, Indents -> Maybe LevelIndents
level8 :: Maybe LevelIndents
, Indents -> Maybe LevelIndents
level9 :: Maybe LevelIndents
} deriving (Int -> Indents -> FilePath -> FilePath
[Indents] -> FilePath -> FilePath
Indents -> FilePath
(Int -> Indents -> FilePath -> FilePath)
-> (Indents -> FilePath)
-> ([Indents] -> FilePath -> FilePath)
-> Show Indents
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Indents -> FilePath -> FilePath
showsPrec :: Int -> Indents -> FilePath -> FilePath
$cshow :: Indents -> FilePath
show :: Indents -> FilePath
$cshowList :: [Indents] -> FilePath -> FilePath
showList :: [Indents] -> FilePath -> FilePath
Show, Indents -> Indents -> Bool
(Indents -> Indents -> Bool)
-> (Indents -> Indents -> Bool) -> Eq Indents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Indents -> Indents -> Bool
== :: Indents -> Indents -> Bool
$c/= :: Indents -> Indents -> Bool
/= :: Indents -> Indents -> Bool
Eq)
levelIndent :: Indents -> Int -> Maybe LevelIndents
levelIndent :: Indents -> Int -> Maybe LevelIndents
levelIndent Indents
is Int
index = Indents -> Maybe LevelIndents
getter Indents
is
where
getter :: Indents -> Maybe LevelIndents
getter = case Int
index of
Int
0 -> Indents -> Maybe LevelIndents
level1
Int
1 -> Indents -> Maybe LevelIndents
level2
Int
2 -> Indents -> Maybe LevelIndents
level3
Int
3 -> Indents -> Maybe LevelIndents
level4
Int
4 -> Indents -> Maybe LevelIndents
level5
Int
5 -> Indents -> Maybe LevelIndents
level6
Int
6 -> Indents -> Maybe LevelIndents
level7
Int
7 -> Indents -> Maybe LevelIndents
level8
Int
8 -> Indents -> Maybe LevelIndents
level9
Int
_ -> Maybe LevelIndents -> Indents -> Maybe LevelIndents
forall a b. a -> b -> a
const Maybe LevelIndents
forall a. Maybe a
Nothing
data LevelIndents = LevelIndents
{ LevelIndents -> Integer
marL :: EMU
, LevelIndents -> Integer
indent :: EMU
} deriving (Int -> LevelIndents -> FilePath -> FilePath
[LevelIndents] -> FilePath -> FilePath
LevelIndents -> FilePath
(Int -> LevelIndents -> FilePath -> FilePath)
-> (LevelIndents -> FilePath)
-> ([LevelIndents] -> FilePath -> FilePath)
-> Show LevelIndents
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> LevelIndents -> FilePath -> FilePath
showsPrec :: Int -> LevelIndents -> FilePath -> FilePath
$cshow :: LevelIndents -> FilePath
show :: LevelIndents -> FilePath
$cshowList :: [LevelIndents] -> FilePath -> FilePath
showList :: [LevelIndents] -> FilePath -> FilePath
Show, LevelIndents -> LevelIndents -> Bool
(LevelIndents -> LevelIndents -> Bool)
-> (LevelIndents -> LevelIndents -> Bool) -> Eq LevelIndents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LevelIndents -> LevelIndents -> Bool
== :: LevelIndents -> LevelIndents -> Bool
$c/= :: LevelIndents -> LevelIndents -> Bool
/= :: LevelIndents -> LevelIndents -> Bool
Eq)
data MediaInfo = MediaInfo { MediaInfo -> FilePath
mInfoFilePath :: FilePath
, MediaInfo -> Int
mInfoLocalId :: Int
, MediaInfo -> Int
mInfoGlobalId :: Int
, MediaInfo -> Maybe Text
mInfoMimeType :: Maybe MimeType
, MediaInfo -> Maybe Text
mInfoExt :: Maybe T.Text
, MediaInfo -> Bool
mInfoCaption :: Bool
} deriving (Int -> MediaInfo -> FilePath -> FilePath
[MediaInfo] -> FilePath -> FilePath
MediaInfo -> FilePath
(Int -> MediaInfo -> FilePath -> FilePath)
-> (MediaInfo -> FilePath)
-> ([MediaInfo] -> FilePath -> FilePath)
-> Show MediaInfo
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> MediaInfo -> FilePath -> FilePath
showsPrec :: Int -> MediaInfo -> FilePath -> FilePath
$cshow :: MediaInfo -> FilePath
show :: MediaInfo -> FilePath
$cshowList :: [MediaInfo] -> FilePath -> FilePath
showList :: [MediaInfo] -> FilePath -> FilePath
Show, MediaInfo -> MediaInfo -> Bool
(MediaInfo -> MediaInfo -> Bool)
-> (MediaInfo -> MediaInfo -> Bool) -> Eq MediaInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MediaInfo -> MediaInfo -> Bool
== :: MediaInfo -> MediaInfo -> Bool
$c/= :: MediaInfo -> MediaInfo -> Bool
/= :: MediaInfo -> MediaInfo -> Bool
Eq)
data WriterState = WriterState { WriterState -> Map Int (Map Int LinkTarget)
stLinkIds :: M.Map Int (M.Map Int LinkTarget)
, WriterState -> Map Int [MediaInfo]
stMediaIds :: M.Map Int [MediaInfo]
, WriterState -> Map FilePath Int
stMediaGlobalIds :: M.Map FilePath Int
, :: Maybe FooterInfo
} deriving (Int -> WriterState -> FilePath -> FilePath
[WriterState] -> FilePath -> FilePath
WriterState -> FilePath
(Int -> WriterState -> FilePath -> FilePath)
-> (WriterState -> FilePath)
-> ([WriterState] -> FilePath -> FilePath)
-> Show WriterState
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> WriterState -> FilePath -> FilePath
showsPrec :: Int -> WriterState -> FilePath -> FilePath
$cshow :: WriterState -> FilePath
show :: WriterState -> FilePath
$cshowList :: [WriterState] -> FilePath -> FilePath
showList :: [WriterState] -> FilePath -> FilePath
Show, WriterState -> WriterState -> Bool
(WriterState -> WriterState -> Bool)
-> (WriterState -> WriterState -> Bool) -> Eq WriterState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WriterState -> WriterState -> Bool
== :: WriterState -> WriterState -> Bool
$c/= :: WriterState -> WriterState -> Bool
/= :: WriterState -> WriterState -> Bool
Eq)
instance Default WriterState where
def :: WriterState
def = WriterState { stLinkIds :: Map Int (Map Int LinkTarget)
stLinkIds = Map Int (Map Int LinkTarget)
forall a. Monoid a => a
mempty
, stMediaIds :: Map Int [MediaInfo]
stMediaIds = Map Int [MediaInfo]
forall a. Monoid a => a
mempty
, stMediaGlobalIds :: Map FilePath Int
stMediaGlobalIds = Map FilePath Int
forall a. Monoid a => a
mempty
, stFooterInfo :: Maybe FooterInfo
stFooterInfo = Maybe FooterInfo
forall a. Maybe a
Nothing
}
type P m = ReaderT WriterEnv (StateT WriterState m)
runP :: Monad m => WriterEnv -> WriterState -> P m a -> m a
runP :: forall (m :: * -> *) a.
Monad m =>
WriterEnv -> WriterState -> P m a -> m a
runP WriterEnv
env WriterState
st P m a
p = StateT WriterState m a -> WriterState -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (P m a -> WriterEnv -> StateT WriterState m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT P m a
p WriterEnv
env) WriterState
st
monospaceFont :: Monad m => P m T.Text
monospaceFont :: forall (m :: * -> *). Monad m => P m Text
monospaceFont = do
vars <- (WriterEnv -> Context Text)
-> ReaderT WriterEnv (StateT WriterState m) (Context Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Context Text
envContext
case lookupContext "monofont" vars of
Just Text
s -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
Maybe Text
Nothing -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"Courier"
fontSizeAttributes :: Monad m => RunProps -> P m [(Text, Text)]
fontSizeAttributes :: forall (m :: * -> *). Monad m => RunProps -> P m [(Text, Text)]
fontSizeAttributes RunProps { rPropForceSize :: RunProps -> Maybe Integer
rPropForceSize = Just Integer
sz } =
[(Text, Text)]
-> ReaderT WriterEnv (StateT WriterState m) [(Text, Text)]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Text
"sz", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
sz Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100)]
fontSizeAttributes RunProps
_ = [(Text, Text)]
-> ReaderT WriterEnv (StateT WriterState m) [(Text, Text)]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
copyFileToArchive :: PandocMonad m => Archive -> FilePath -> P m Archive
copyFileToArchive :: forall (m :: * -> *).
PandocMonad m =>
Archive -> FilePath -> P m Archive
copyFileToArchive Archive
arch FilePath
fp = do
refArchive <- (WriterEnv -> Archive)
-> ReaderT WriterEnv (StateT WriterState m) Archive
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
distArchive <- asks envDistArchive
case findEntryByPath fp refArchive `mplus` findEntryByPath fp distArchive of
Maybe Entry
Nothing -> PandocError -> ReaderT WriterEnv (StateT WriterState m) Archive
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ReaderT WriterEnv (StateT WriterState m) Archive)
-> PandocError -> ReaderT WriterEnv (StateT WriterState m) Archive
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError
(Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack
(FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" missing in reference file"
Just Entry
e -> Archive -> ReaderT WriterEnv (StateT WriterState m) Archive
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Archive -> ReaderT WriterEnv (StateT WriterState m) Archive)
-> Archive -> ReaderT WriterEnv (StateT WriterState m) Archive
forall a b. (a -> b) -> a -> b
$ Entry -> Archive -> Archive
addEntryToArchive Entry
e Archive
arch
alwaysInheritedPatterns :: [Pattern]
alwaysInheritedPatterns :: [Pattern]
alwaysInheritedPatterns =
(FilePath -> Pattern) -> [FilePath] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Pattern
compile [ FilePath
"docProps/app.xml"
, FilePath
"ppt/slideLayouts/slideLayout*.xml"
, FilePath
"ppt/slideLayouts/_rels/slideLayout*.xml.rels"
, FilePath
"ppt/slideMasters/slideMaster1.xml"
, FilePath
"ppt/slideMasters/_rels/slideMaster1.xml.rels"
, FilePath
"ppt/theme/theme*.xml"
, FilePath
"ppt/theme/_rels/theme*.xml.rels"
, FilePath
"ppt/presProps.xml"
, FilePath
"ppt/tableStyles.xml"
, FilePath
"ppt/media/image*"
, FilePath
"ppt/fonts/*"
]
contingentInheritedPatterns :: Presentation -> [Pattern]
contingentInheritedPatterns :: Presentation -> [Pattern]
contingentInheritedPatterns Presentation
pres = [] [Pattern] -> [Pattern] -> [Pattern]
forall a. Semigroup a => a -> a -> a
<>
if Presentation -> Bool
presHasSpeakerNotes Presentation
pres
then (FilePath -> Pattern) -> [FilePath] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Pattern
compile [ FilePath
"ppt/notesMasters/notesMaster*.xml"
, FilePath
"ppt/notesMasters/_rels/notesMaster*.xml.rels"
]
else []
inheritedPatterns :: Presentation -> [Pattern]
inheritedPatterns :: Presentation -> [Pattern]
inheritedPatterns Presentation
pres =
[Pattern]
alwaysInheritedPatterns [Pattern] -> [Pattern] -> [Pattern]
forall a. Semigroup a => a -> a -> a
<> Presentation -> [Pattern]
contingentInheritedPatterns Presentation
pres
patternToFilePaths :: PandocMonad m => Pattern -> P m [FilePath]
patternToFilePaths :: forall (m :: * -> *). PandocMonad m => Pattern -> P m [FilePath]
patternToFilePaths Pattern
pat = do
refArchive <- (WriterEnv -> Archive)
-> ReaderT WriterEnv (StateT WriterState m) Archive
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
distArchive <- asks envDistArchive
let archiveFiles = Archive -> [FilePath]
filesInArchive Archive
refArchive [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
`union` Archive -> [FilePath]
filesInArchive Archive
distArchive
return $ filter (match pat) archiveFiles
patternsToFilePaths :: PandocMonad m => [Pattern] -> P m [FilePath]
patternsToFilePaths :: forall (m :: * -> *). PandocMonad m => [Pattern] -> P m [FilePath]
patternsToFilePaths [Pattern]
pats = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> ReaderT WriterEnv (StateT WriterState m) [[FilePath]]
-> ReaderT WriterEnv (StateT WriterState m) [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern -> ReaderT WriterEnv (StateT WriterState m) [FilePath])
-> [Pattern]
-> ReaderT WriterEnv (StateT WriterState m) [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pattern -> ReaderT WriterEnv (StateT WriterState m) [FilePath]
forall (m :: * -> *). PandocMonad m => Pattern -> P m [FilePath]
patternToFilePaths [Pattern]
pats
requiredFiles :: [FilePath]
requiredFiles :: [FilePath]
requiredFiles = [ FilePath
"docProps/app.xml"
, FilePath
"ppt/presProps.xml"
, FilePath
"ppt/slideLayouts/slideLayout1.xml"
, FilePath
"ppt/slideLayouts/_rels/slideLayout1.xml.rels"
, FilePath
"ppt/slideLayouts/slideLayout2.xml"
, FilePath
"ppt/slideLayouts/_rels/slideLayout2.xml.rels"
, FilePath
"ppt/slideLayouts/slideLayout3.xml"
, FilePath
"ppt/slideLayouts/_rels/slideLayout3.xml.rels"
, FilePath
"ppt/slideLayouts/slideLayout4.xml"
, FilePath
"ppt/slideLayouts/_rels/slideLayout4.xml.rels"
, FilePath
"ppt/slideMasters/slideMaster1.xml"
, FilePath
"ppt/slideMasters/_rels/slideMaster1.xml.rels"
, FilePath
"ppt/theme/theme1.xml"
, FilePath
"ppt/tableStyles.xml"
]
presentationToArchiveP :: PandocMonad m => Presentation -> P m Archive
presentationToArchiveP :: forall (m :: * -> *). PandocMonad m => Presentation -> P m Archive
presentationToArchiveP p :: Presentation
p@(Presentation DocProps
docProps [Slide]
slides) = do
filePaths <- [Pattern] -> P m [FilePath]
forall (m :: * -> *). PandocMonad m => [Pattern] -> P m [FilePath]
patternsToFilePaths ([Pattern] -> P m [FilePath]) -> [Pattern] -> P m [FilePath]
forall a b. (a -> b) -> a -> b
$ Presentation -> [Pattern]
inheritedPatterns Presentation
p
let missingFiles = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
filePaths) [FilePath]
requiredFiles
unless (null missingFiles)
(throwError $
PandocSomeError $
"The following required files are missing:\n" <>
T.unlines (map (T.pack . (" " <>)) missingFiles)
)
newArch <- foldM copyFileToArchive emptyArchive filePaths
slideLayouts <- getSlideLayouts
let f SlideLayout
layout =
if Bool -> Bool
not (SlideLayout -> Bool
slInReferenceDoc SlideLayout
layout)
then Entry -> Archive -> Archive
addEntryToArchive (SlideLayout -> Entry
slEntry SlideLayout
layout)
else Archive -> Archive
forall a. a -> a
id
let newArch' = (SlideLayout -> Archive -> Archive)
-> Archive -> SlideLayouts -> Archive
forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SlideLayout -> Archive -> Archive
f Archive
newArch SlideLayouts
slideLayouts
master <- getMaster
refArchive <- asks envRefArchive
distArchive <- asks envDistArchive
presentationElement <- parseXml refArchive distArchive "ppt/presentation.xml"
modify (\WriterState
s ->
WriterState
s {stFooterInfo =
getFooterInfo (dcDate docProps) slideLayouts master presentationElement
})
masterRels <- getMasterRels
let (updatedMasterElem, updatedMasterRelElem) = updateMasterElems slideLayouts master masterRels
updatedMasterEntry <- elemToEntry "ppt/slideMasters/slideMaster1.xml" updatedMasterElem
updatedMasterRelEntry <- elemToEntry "ppt/slideMasters/_rels/slideMaster1.xml.rels" updatedMasterRelElem
viewPropsEntry <- makeViewPropsEntry
docPropsEntry <- docPropsToEntry docProps
docCustomPropsEntry <- docCustomPropsToEntry docProps
relsEntry <- topLevelRelsEntry
(presentationRIdUpdateData, presRelsEntry) <- presentationToRelsEntry p
presEntry <- presentationToPresEntry presentationRIdUpdateData p
slideEntries <- mapM slideToEntry slides
slideRelEntries <- mapM slideToSlideRelEntry slides
spkNotesEntries <- catMaybes <$> mapM slideToSpeakerNotesEntry slides
spkNotesRelEntries <- catMaybes <$> mapM slideToSpeakerNotesRelEntry slides
mediaEntries <- makeMediaEntries
contentTypesEntry <- presentationToContentTypes p >>= contentTypesToEntry
return $ foldr addEntryToArchive newArch' $
slideEntries <>
slideRelEntries <>
spkNotesEntries <>
spkNotesRelEntries <>
mediaEntries <>
[updatedMasterEntry, updatedMasterRelEntry] <>
[contentTypesEntry, docPropsEntry, docCustomPropsEntry, relsEntry,
presEntry, presRelsEntry, viewPropsEntry]
updateMasterElems :: SlideLayouts -> Element -> Element -> (Element, Element)
updateMasterElems :: SlideLayouts -> Element -> Element -> (Element, Element)
updateMasterElems SlideLayouts
layouts Element
master Element
masterRels = (Element
updatedMaster, Element
updatedMasterRels)
where
updatedMaster :: Element
updatedMaster = Element
master { elContent = updateSldLayoutIdLst <$> elContent master }
([Text]
updatedRelationshipIds, Element
updatedMasterRels) = Element -> ([Text], Element)
addLayoutRels Element
masterRels
updateSldLayoutIdLst :: Content -> Content
updateSldLayoutIdLst :: Content -> Content
updateSldLayoutIdLst (Elem Element
e) = case Element -> QName
elName Element
e of
(QName Text
"sldLayoutIdLst" Maybe Text
_ Maybe Text
_) -> let
mkChild :: Text -> (a, [Content]) -> (a, [Content])
mkChild Text
relationshipId (a
lastId, [Content]
children) = let
thisId :: a
thisId = a
lastId a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
newChild :: Element
newChild = Element
{ elName :: QName
elName = Text -> Maybe Text -> Maybe Text -> QName
QName Text
"sldLayoutId" Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"p")
, elAttribs :: [Attr]
elAttribs =
[ QName -> Text -> Attr
Attr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"id" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) (FilePath -> Text
T.pack (a -> FilePath
forall a. Show a => a -> FilePath
show a
thisId))
, QName -> Text -> Attr
Attr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"id" Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"r")) Text
relationshipId
]
, elContent :: [Content]
elContent = []
, elLine :: Maybe Integer
elLine = Maybe Integer
forall a. Maybe a
Nothing
}
in (a
thisId, Element -> Content
Elem Element
newChild Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
children)
newChildren :: [Content]
newChildren = (Integer, [Content]) -> [Content]
forall a b. (a, b) -> b
snd ((Text -> (Integer, [Content]) -> (Integer, [Content]))
-> (Integer, [Content]) -> [Text] -> (Integer, [Content])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> (Integer, [Content]) -> (Integer, [Content])
forall {a}.
(Num a, Show a) =>
Text -> (a, [Content]) -> (a, [Content])
mkChild (Element -> Integer
maxIdNumber' Element
e, []) [Text]
updatedRelationshipIds)
in Element -> Content
Elem Element
e { elContent = elContent e <> newChildren }
QName
_ -> Element -> Content
Elem Element
e
updateSldLayoutIdLst Content
c = Content
c
addLayoutRels ::
Element ->
([Text], Element)
addLayoutRels :: Element -> ([Text], Element)
addLayoutRels Element
e = let
layoutsToAdd :: [SlideLayout]
layoutsToAdd = (SlideLayout -> Bool) -> [SlideLayout] -> [SlideLayout]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SlideLayout
l -> Bool -> Bool
not (SlideLayout -> Bool
slInReferenceDoc SlideLayout
l) Bool -> Bool -> Bool
&& Element -> SlideLayout -> Bool
isNew Element
e SlideLayout
l)
(SlideLayouts -> [SlideLayout]
forall a. SlideLayoutsOf a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SlideLayouts
layouts)
newRelationships :: [Content]
newRelationships = (Integer, [Content]) -> [Content]
forall a b. (a, b) -> b
snd ((SlideLayout -> (Integer, [Content]) -> (Integer, [Content]))
-> (Integer, [Content]) -> [SlideLayout] -> (Integer, [Content])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SlideLayout -> (Integer, [Content]) -> (Integer, [Content])
forall {a}.
(Num a, Show a) =>
SlideLayout -> (a, [Content]) -> (a, [Content])
mkRelationship (Element -> Integer
maxIdNumber Element
e, []) [SlideLayout]
layoutsToAdd)
newRelationshipIds :: [Text]
newRelationshipIds =
(Content -> Maybe Text) -> [Content] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (QName -> Content -> Maybe Text
findElemAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Id" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing)) [Content]
newRelationships
mkRelationship :: SlideLayout -> (a, [Content]) -> (a, [Content])
mkRelationship SlideLayout
layout (a
lastId, [Content]
relationships) = let
thisId :: a
thisId = a
lastId a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
slideLayoutPath :: Text
slideLayoutPath = Text
"../slideLayouts/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath -> FilePath
takeFileName (SlideLayout -> FilePath
slPath SlideLayout
layout))
newRelationship :: Element
newRelationship = Element
{ elName :: QName
elName = Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Relationship" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
, elAttribs :: [Attr]
elAttribs =
[ QName -> Text -> Attr
Attr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Id" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) (Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (a -> FilePath
forall a. Show a => a -> FilePath
show a
thisId))
, QName -> Text -> Attr
Attr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Type" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout"
, QName -> Text -> Attr
Attr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Target" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Text
slideLayoutPath
]
, elContent :: [Content]
elContent = []
, elLine :: Maybe Integer
elLine = Maybe Integer
forall a. Maybe a
Nothing
}
in (a
thisId, Element -> Content
Elem Element
newRelationship Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
relationships)
in ([Text]
newRelationshipIds, Element
e {elContent = elContent e <> newRelationships})
isNew :: Element -> SlideLayout -> Bool
isNew :: Element -> SlideLayout -> Bool
isNew Element
relationships SlideLayout{Bool
FilePath
Element
Entry
slElement :: SlideLayout -> Element
slInReferenceDoc :: SlideLayout -> Bool
slPath :: SlideLayout -> FilePath
slEntry :: SlideLayout -> Entry
slElement :: Element
slInReferenceDoc :: Bool
slPath :: FilePath
slEntry :: Entry
..} = let
toDetails :: Content -> Maybe FilePath
toDetails = (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath
takeFileName (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)
(Maybe Text -> Maybe FilePath)
-> (Content -> Maybe Text) -> Content -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Content -> Maybe Text
findElemAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Target" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing)
in FilePath -> FilePath
takeFileName FilePath
slPath FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Content -> Maybe FilePath) -> [Content] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Content -> Maybe FilePath
toDetails (Element -> [Content]
elContent Element
relationships)
findElemAttr :: QName -> Content -> Maybe Text
findElemAttr :: QName -> Content -> Maybe Text
findElemAttr QName
attr (Elem Element
e) = QName -> Element -> Maybe Text
findAttr QName
attr Element
e
findElemAttr QName
_ Content
_ = Maybe Text
forall a. Maybe a
Nothing
maxIdNumber :: Element -> Integer
maxIdNumber :: Element -> Integer
maxIdNumber Element
relationships = [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Integer
0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
idNumbers)
where
idNumbers :: [Integer]
idNumbers = (Text -> Maybe Integer) -> [Text] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Integer
readTextAsInteger (Text -> Maybe Integer) -> (Text -> Text) -> Text -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
3) [Text]
idAttributes
idAttributes :: [Text]
idAttributes = (Content -> Maybe Text) -> [Content] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Content -> Maybe Text
getIdAttribute (Element -> [Content]
elContent Element
relationships)
getIdAttribute :: Content -> Maybe Text
getIdAttribute (Elem Element
e) = QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Id" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
e
getIdAttribute Content
_ = Maybe Text
forall a. Maybe a
Nothing
maxIdNumber' :: Element -> Integer
maxIdNumber' :: Element -> Integer
maxIdNumber' Element
sldLayouts = [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Integer
0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
idNumbers)
where
idNumbers :: [Integer]
idNumbers = (Text -> Maybe Integer) -> [Text] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Integer
readTextAsInteger [Text]
idAttributes
idAttributes :: [Text]
idAttributes = (Content -> Maybe Text) -> [Content] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Content -> Maybe Text
getIdAttribute (Element -> [Content]
elContent Element
sldLayouts)
getIdAttribute :: Content -> Maybe Text
getIdAttribute (Elem Element
e) = QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"id" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
e
getIdAttribute Content
_ = Maybe Text
forall a. Maybe a
Nothing
data =
{ FooterInfo -> SlideLayoutsOf (Maybe Element)
fiDate :: SlideLayoutsOf (Maybe Element)
, :: SlideLayoutsOf (Maybe Element)
, FooterInfo -> SlideLayoutsOf (Maybe Element)
fiSlideNumber :: SlideLayoutsOf (Maybe Element)
, FooterInfo -> Bool
fiShowOnFirstSlide :: Bool
} deriving (Int -> FooterInfo -> FilePath -> FilePath
[FooterInfo] -> FilePath -> FilePath
FooterInfo -> FilePath
(Int -> FooterInfo -> FilePath -> FilePath)
-> (FooterInfo -> FilePath)
-> ([FooterInfo] -> FilePath -> FilePath)
-> Show FooterInfo
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> FooterInfo -> FilePath -> FilePath
showsPrec :: Int -> FooterInfo -> FilePath -> FilePath
$cshow :: FooterInfo -> FilePath
show :: FooterInfo -> FilePath
$cshowList :: [FooterInfo] -> FilePath -> FilePath
showList :: [FooterInfo] -> FilePath -> FilePath
Show, FooterInfo -> FooterInfo -> Bool
(FooterInfo -> FooterInfo -> Bool)
-> (FooterInfo -> FooterInfo -> Bool) -> Eq FooterInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FooterInfo -> FooterInfo -> Bool
== :: FooterInfo -> FooterInfo -> Bool
$c/= :: FooterInfo -> FooterInfo -> Bool
/= :: FooterInfo -> FooterInfo -> Bool
Eq)
getFooterInfo :: Maybe Text -> SlideLayouts -> Element -> Element -> Maybe FooterInfo
Maybe Text
date SlideLayouts
layouts Element
master Element
presentation = do
let ns :: [(Text, Text)]
ns = Element -> [(Text, Text)]
elemToNameSpaces Element
master
hf <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"hf") Element
master
let fiDate = let
f :: Element -> Element
f Element
layoutDate =
case Maybe Text
date of
Maybe Text
Nothing -> Element
layoutDate
Just Text
d ->
if [(Text, Text)] -> Element -> Bool
dateIsAutomatic (Element -> [(Text, Text)]
elemToNameSpaces Element
layoutDate) Element
layoutDate
then Element
layoutDate
else Text -> Element -> Element
replaceDate Text
d Element
layoutDate
in (Element -> Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Element
f (Maybe Element -> Maybe Element)
-> (SlideLayout -> Maybe Element) -> SlideLayout -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Element -> Element -> Maybe Element
getShape Text
"dt" Element
hf (Element -> Maybe Element)
-> (SlideLayout -> Element) -> SlideLayout -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlideLayout -> Element
slElement (SlideLayout -> Maybe Element)
-> SlideLayouts -> SlideLayoutsOf (Maybe Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlideLayouts
layouts
fiFooter = Text -> Element -> Element -> Maybe Element
getShape Text
"ftr" Element
hf (Element -> Maybe Element)
-> (SlideLayout -> Element) -> SlideLayout -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlideLayout -> Element
slElement (SlideLayout -> Maybe Element)
-> SlideLayouts -> SlideLayoutsOf (Maybe Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlideLayouts
layouts
fiSlideNumber = Text -> Element -> Element -> Maybe Element
getShape Text
"sldNum" Element
hf (Element -> Maybe Element)
-> (SlideLayout -> Element) -> SlideLayout -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlideLayout -> Element
slElement (SlideLayout -> Maybe Element)
-> SlideLayouts -> SlideLayoutsOf (Maybe Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlideLayouts
layouts
fiShowOnFirstSlide =
Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True
(Text -> Element -> Maybe Bool
getBooleanAttribute Text
"showSpecialPlsOnTitleSld" Element
presentation)
pure FooterInfo{..}
where
getShape :: Text -> Element -> Element -> Maybe Element
getShape Text
t Element
hf Element
layout =
if Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Text -> Element -> Maybe Bool
getBooleanAttribute Text
t Element
hf)
then do
let ns :: [(Text, Text)]
ns = Element -> [(Text, Text)]
elemToNameSpaces Element
layout
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
spTree <- findChild (elemName ns "p" "spTree") cSld
let containsPlaceholder Element
sp = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
nvSpPr <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"nvSpPr") Element
sp
nvPr <- findChild (elemName ns "p" "nvPr") nvSpPr
ph <- findChild (elemName ns "p" "ph") nvPr
placeholderType <- findAttr (QName "type" Nothing Nothing) ph
pure (placeholderType == t)
listToMaybe (filterChildren containsPlaceholder spTree)
else Maybe Element
forall a. Maybe a
Nothing
dateIsAutomatic :: NameSpaces -> Element -> Bool
dateIsAutomatic :: [(Text, Text)] -> Element -> Bool
dateIsAutomatic [(Text, Text)]
ns Element
shape = Maybe Element -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Element -> Bool) -> Maybe Element -> Bool
forall a b. (a -> b) -> a -> b
$ do
txBody <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"txBody") Element
shape
p <- findChild (elemName ns "a" "p") txBody
findChild (elemName ns "a" "fld") p
replaceDate :: Text -> Element -> Element
replaceDate :: Text -> Element -> Element
replaceDate Text
newDate Element
e =
Element
e { elContent =
case (elName e) of
QName Text
"t" Maybe Text
_ (Just Text
"a") ->
[ CData -> Content
Text (CData { cdVerbatim :: CDataKind
cdVerbatim = CDataKind
CDataText
, cdData :: Text
cdData = Text
newDate
, cdLine :: Maybe Integer
cdLine = Maybe Integer
forall a. Maybe a
Nothing
})
]
QName
_ -> (Element -> Element) -> Content -> Content
ifElem (Text -> Element -> Element
replaceDate Text
newDate) (Content -> Content) -> [Content] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> [Content]
elContent Element
e
}
ifElem :: (Element -> Element) -> (Content -> Content)
ifElem :: (Element -> Element) -> Content -> Content
ifElem Element -> Element
f (Elem Element
e) = Element -> Content
Elem (Element -> Element
f Element
e)
ifElem Element -> Element
_ Content
c = Content
c
getBooleanAttribute :: Text -> Element -> Maybe Bool
getBooleanAttribute Text
t Element
e =
(Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"1", Text
"true"]) (Text -> Bool) -> Maybe Text -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
t Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
e)
footerElements ::
PandocMonad m =>
(forall a. SlideLayoutsOf a -> a) ->
P m [Content]
forall a. SlideLayoutsOf a -> a
layout = do
footerInfo <- (WriterState -> Maybe FooterInfo)
-> ReaderT WriterEnv (StateT WriterState m) (Maybe FooterInfo)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe FooterInfo
stFooterInfo
pure
$ Elem <$>
(toList (footerInfo >>= layout . fiDate)
<> toList (footerInfo >>= layout . fiFooter)
<> toList (footerInfo >>= layout . fiSlideNumber))
makeSlideIdMap :: Presentation -> M.Map SlideId Int
makeSlideIdMap :: Presentation -> Map SlideId Int
makeSlideIdMap (Presentation DocProps
_ [Slide]
slides) =
[(SlideId, Int)] -> Map SlideId Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SlideId, Int)] -> Map SlideId Int)
-> [(SlideId, Int)] -> Map SlideId Int
forall a b. (a -> b) -> a -> b
$ (Slide -> SlideId) -> [Slide] -> [SlideId]
forall a b. (a -> b) -> [a] -> [b]
map Slide -> SlideId
slideId [Slide]
slides [SlideId] -> [Int] -> [(SlideId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1..]
makeSpeakerNotesMap :: Presentation -> M.Map Int Int
makeSpeakerNotesMap :: Presentation -> Map Int Int
makeSpeakerNotesMap (Presentation DocProps
_ [Slide]
slides) =
[(Int, Int)] -> Map Int Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, Int)] -> Map Int Int) -> [(Int, Int)] -> Map Int Int
forall a b. (a -> b) -> a -> b
$
((Slide, Int) -> Maybe Int) -> [(Slide, Int)] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Slide, Int) -> Maybe Int
forall {a}. (Slide, a) -> Maybe a
f ([Slide]
slides [Slide] -> [Int] -> [(Slide, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1..]) [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1..]
where f :: (Slide, a) -> Maybe a
f (Slide SlideId
_ Layout
_ SpeakerNotes
notes Maybe FilePath
_, a
n) = if SpeakerNotes
notes SpeakerNotes -> SpeakerNotes -> Bool
forall a. Eq a => a -> a -> Bool
== SpeakerNotes
forall a. Monoid a => a
mempty
then Maybe a
forall a. Maybe a
Nothing
else a -> Maybe a
forall a. a -> Maybe a
Just a
n
presentationToArchive :: PandocMonad m
=> WriterOptions -> Meta -> Presentation -> m Archive
presentationToArchive :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Meta -> Presentation -> m Archive
presentationToArchive WriterOptions
opts Meta
meta Presentation
pres = do
distArchive <- ByteString -> Archive
toArchive (ByteString -> Archive)
-> (StrictByteString -> ByteString) -> StrictByteString -> Archive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> ByteString
BL.fromStrict (StrictByteString -> Archive) -> m StrictByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
FilePath -> m StrictByteString
forall (m :: * -> *).
PandocMonad m =>
FilePath -> m StrictByteString
readDefaultDataFile FilePath
"reference.pptx"
refArchive <- case writerReferenceDoc opts of
Just FilePath
f -> ByteString -> Archive
toArchive (ByteString -> Archive)
-> ((StrictByteString, Maybe Text) -> ByteString)
-> (StrictByteString, Maybe Text)
-> Archive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> ByteString
BL.fromStrict (StrictByteString -> ByteString)
-> ((StrictByteString, Maybe Text) -> StrictByteString)
-> (StrictByteString, Maybe Text)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictByteString, Maybe Text) -> StrictByteString
forall a b. (a, b) -> a
fst
((StrictByteString, Maybe Text) -> Archive)
-> m (StrictByteString, Maybe Text) -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (StrictByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (StrictByteString, Maybe Text)
P.fetchItem (FilePath -> Text
T.pack FilePath
f)
Maybe FilePath
Nothing -> ByteString -> Archive
toArchive (ByteString -> Archive)
-> (StrictByteString -> ByteString) -> StrictByteString -> Archive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> ByteString
BL.fromStrict (StrictByteString -> Archive) -> m StrictByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
FilePath -> m StrictByteString
forall (m :: * -> *).
PandocMonad m =>
FilePath -> m StrictByteString
readDataFile FilePath
"reference.pptx"
let (referenceLayouts, defaultReferenceLayouts) =
(getLayoutsFromArchive refArchive, getLayoutsFromArchive distArchive)
let layoutTitles = SlideLayouts { metadata :: Text
metadata = Text
"Title Slide" :: Text
, title :: Text
title = Text
"Section Header"
, content :: Text
content = Text
"Title and Content"
, twoColumn :: Text
twoColumn = Text
"Two Content"
, comparison :: Text
comparison = Text
"Comparison"
, contentWithCaption :: Text
contentWithCaption = Text
"Content with Caption"
, blank :: Text
blank = Text
"Blank"
}
layouts <- for layoutTitles $ \Text
layoutTitle -> do
let layout :: Maybe (NonEmpty (Element, FilePath, Entry))
layout = CI Text
-> Map (CI Text) (NonEmpty (Element, FilePath, Entry))
-> Maybe (NonEmpty (Element, FilePath, Entry))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk Text
layoutTitle) Map (CI Text) (NonEmpty (Element, FilePath, Entry))
referenceLayouts
let defaultLayout :: Maybe (NonEmpty (Element, FilePath, Entry))
defaultLayout = CI Text
-> Map (CI Text) (NonEmpty (Element, FilePath, Entry))
-> Maybe (NonEmpty (Element, FilePath, Entry))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk Text
layoutTitle) Map (CI Text) (NonEmpty (Element, FilePath, Entry))
defaultReferenceLayouts
case (Maybe (NonEmpty (Element, FilePath, Entry))
layout, Maybe (NonEmpty (Element, FilePath, Entry))
defaultLayout) of
(Maybe (NonEmpty (Element, FilePath, Entry))
Nothing, Maybe (NonEmpty (Element, FilePath, Entry))
Nothing) ->
PandocError -> m SlideLayout
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> PandocError
PandocSomeError (Text
"Couldn't find layout named \""
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
layoutTitle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" in the provided "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"reference doc or in the default "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"reference doc included with pandoc."))
(Maybe (NonEmpty (Element, FilePath, Entry))
Nothing, Just ((Element
element, FilePath
path, Entry
entry) :| [(Element, FilePath, Entry)]
_)) -> do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
P.report (Text -> LogMessage
PowerpointTemplateWarning
(Text
"Couldn't find layout named \""
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
layoutTitle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" in provided "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"reference doc. Falling back to "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"the default included with pandoc."))
SlideLayout -> m SlideLayout
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SlideLayout { slElement :: Element
slElement = Element
element
, slPath :: FilePath
slPath = FilePath
path
, slEntry :: Entry
slEntry = Entry
entry
, slInReferenceDoc :: Bool
slInReferenceDoc = Bool
False
}
(Just ((Element
element, FilePath
path, Entry
entry) :| [(Element, FilePath, Entry)]
_), Maybe (NonEmpty (Element, FilePath, Entry))
_ ) ->
SlideLayout -> m SlideLayout
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SlideLayout { slElement :: Element
slElement = Element
element
, slPath :: FilePath
slPath = FilePath
path
, slEntry :: Entry
slEntry = Entry
entry
, slInReferenceDoc :: Bool
slInReferenceDoc = Bool
True
}
master <- getMaster' refArchive distArchive
let otherStyleIndents = do
let ns :: [(Text, Text)]
ns = Element -> [(Text, Text)]
elemToNameSpaces Element
master
txStyles <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"txStyles") Element
master
otherStyle <- findChild (elemName ns "p" "otherStyle") txStyles
let makeLevelIndents Text
name = do
e <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"a" Text
name) Element
otherStyle
pure LevelIndents
{ indent = fromMaybe (-342900)
(findAttr (QName "indent" Nothing Nothing) e
>>= readTextAsInteger)
, marL = fromMaybe 347663
(findAttr (QName "marL" Nothing Nothing) e
>>= readTextAsInteger)
}
pure Indents
{ level1 = makeLevelIndents "lvl1pPr"
, level2 = makeLevelIndents "lvl2pPr"
, level3 = makeLevelIndents "lvl3pPr"
, level4 = makeLevelIndents "lvl4pPr"
, level5 = makeLevelIndents "lvl5pPr"
, level6 = makeLevelIndents "lvl6pPr"
, level7 = makeLevelIndents "lvl7pPr"
, level8 = makeLevelIndents "lvl8pPr"
, level9 = makeLevelIndents "lvl9pPr"
}
utctime <- P.getTimestamp
presSize <- case getPresentationSize refArchive distArchive of
Just (Integer, Integer)
sz -> (Integer, Integer) -> m (Integer, Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer, Integer)
sz
Maybe (Integer, Integer)
Nothing -> PandocError -> m (Integer, Integer)
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Integer, Integer))
-> PandocError -> m (Integer, Integer)
forall a b. (a -> b) -> a -> b
$
Text -> PandocError
PandocSomeError
Text
"Could not determine presentation size"
context <- metaToContext opts{ writerTemplate =
writerTemplate opts <|> Just mempty }
(return . literal . stringify)
(return . literal . stringify) meta
let env = WriterEnv
forall a. Default a => a
def { envRefArchive = refArchive
, envDistArchive = distArchive
, envUTCTime = utctime
, envOpts = opts
, envContext = context
, envPresentationSize = presSize
, envSlideIdMap = makeSlideIdMap pres
, envSpeakerNotesIdMap = makeSpeakerNotesMap pres
, envSlideLayouts = Just layouts
, envOtherStyleIndents = otherStyleIndents
}
let st = WriterState
forall a. Default a => a
def { stMediaGlobalIds = initialGlobalIds refArchive distArchive
}
runP env st $ presentationToArchiveP pres
getLayoutsFromArchive :: Archive -> M.Map (CI Text) (NonEmpty (Element, FilePath, Entry))
getLayoutsFromArchive :: Archive -> Map (CI Text) (NonEmpty (Element, FilePath, Entry))
getLayoutsFromArchive Archive
archive =
(NonEmpty (Element, FilePath, Entry)
-> NonEmpty (Element, FilePath, Entry)
-> NonEmpty (Element, FilePath, Entry))
-> [(CI Text, NonEmpty (Element, FilePath, Entry))]
-> Map (CI Text) (NonEmpty (Element, FilePath, Entry))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith NonEmpty (Element, FilePath, Entry)
-> NonEmpty (Element, FilePath, Entry)
-> NonEmpty (Element, FilePath, Entry)
forall a. Semigroup a => a -> a -> a
(<>) ((\t :: (Element, FilePath, Entry)
t@(Element
e, FilePath
_, Entry
_) -> (Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Element -> Text
name Element
e), (Element, FilePath, Entry) -> NonEmpty (Element, FilePath, Entry)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Element, FilePath, Entry)
t)) ((Element, FilePath, Entry)
-> (CI Text, NonEmpty (Element, FilePath, Entry)))
-> [(Element, FilePath, Entry)]
-> [(CI Text, NonEmpty (Element, FilePath, Entry))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Element, FilePath, Entry)]
layouts)
where
layouts :: [(Element, FilePath, Entry)]
layouts :: [(Element, FilePath, Entry)]
layouts = (FilePath -> Maybe (Element, FilePath, Entry))
-> [FilePath] -> [(Element, FilePath, Entry)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe (Element, FilePath, Entry)
findElementByPath [FilePath]
paths
parseXml' :: Entry -> Maybe Element
parseXml' Entry
entry = case Text -> Either Text Element
parseXMLElement (ByteString -> Text
UTF8.toTextLazy (Entry -> ByteString
fromEntry Entry
entry)) of
Left Text
_ -> Maybe Element
forall a. Maybe a
Nothing
Right Element
element -> Element -> Maybe Element
forall a. a -> Maybe a
Just Element
element
findElementByPath :: FilePath -> Maybe (Element, FilePath, Entry)
findElementByPath :: FilePath -> Maybe (Element, FilePath, Entry)
findElementByPath FilePath
path = do
entry <- FilePath -> Archive -> Maybe Entry
findEntryByPath FilePath
path Archive
archive
element <- parseXml' entry
pure (element, path, entry)
paths :: [FilePath]
paths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pattern -> FilePath -> Bool
match (FilePath -> Pattern
compile FilePath
"ppt/slideLayouts/slideLayout*.xml")) (Archive -> [FilePath]
filesInArchive Archive
archive)
name :: Element -> Text
name Element
element = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"Untitled layout" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ do
let ns :: [(Text, Text)]
ns = Element -> [(Text, Text)]
elemToNameSpaces Element
element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
element
findAttr (QName "name" Nothing Nothing) cSld
presHasSpeakerNotes :: Presentation -> Bool
presHasSpeakerNotes :: Presentation -> Bool
presHasSpeakerNotes (Presentation DocProps
_ [Slide]
slides) =
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Slide -> Bool) -> [Slide] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((SpeakerNotes
forall a. Monoid a => a
mempty SpeakerNotes -> SpeakerNotes -> Bool
forall a. Eq a => a -> a -> Bool
==) (SpeakerNotes -> Bool) -> (Slide -> SpeakerNotes) -> Slide -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slide -> SpeakerNotes
slideSpeakerNotes) [Slide]
slides
curSlideHasSpeakerNotes :: PandocMonad m => P m Bool
curSlideHasSpeakerNotes :: forall (m :: * -> *). PandocMonad m => P m Bool
curSlideHasSpeakerNotes =
Int -> Map Int Int -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member (Int -> Map Int Int -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Int
-> ReaderT WriterEnv (StateT WriterState m) (Map Int Int -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envCurSlideId ReaderT WriterEnv (StateT WriterState m) (Map Int Int -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) (Map Int Int)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall a b.
ReaderT WriterEnv (StateT WriterState m) (a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (WriterEnv -> Map Int Int)
-> ReaderT WriterEnv (StateT WriterState m) (Map Int Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Map Int Int
envSpeakerNotesIdMap
getLayout :: PandocMonad m => Layout -> P m Element
getLayout :: forall (m :: * -> *). PandocMonad m => Layout -> P m Element
getLayout Layout
layout = SlideLayouts -> Element
getElement (SlideLayouts -> Element)
-> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
-> ReaderT WriterEnv (StateT WriterState m) Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
forall (m :: * -> *). PandocMonad m => P m SlideLayouts
getSlideLayouts
where
getElement :: SlideLayouts -> Element
getElement =
SlideLayout -> Element
slElement (SlideLayout -> Element)
-> (SlideLayouts -> SlideLayout) -> SlideLayouts -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Layout
layout of
MetadataSlide{} -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
metadata
TitleSlide{} -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
title
ContentSlide{} -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
content
TwoColumnSlide{} -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
twoColumn
ComparisonSlide{} -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
comparison
ContentWithCaptionSlide{} -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
contentWithCaption
BlankSlide{} -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
blank
shapeHasId :: NameSpaces -> T.Text -> Element -> Bool
shapeHasId :: [(Text, Text)] -> Text -> Element -> Bool
shapeHasId [(Text, Text)]
ns Text
ident Element
element = [(Text, Text)] -> Element -> Maybe Text
getShapeId [(Text, Text)]
ns Element
element Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
getShapeId :: NameSpaces -> Element -> Maybe Text
getShapeId :: [(Text, Text)] -> Element -> Maybe Text
getShapeId [(Text, Text)]
ns Element
element = do
nvSpPr <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"nvSpPr") Element
element
cNvPr <- findChild (elemName ns "p" "cNvPr") nvSpPr
findAttr (QName "id" Nothing Nothing) cNvPr
type ShapeId = Integer
getContentShape :: PandocMonad m => NameSpaces -> Element -> P m (Maybe ShapeId, Element)
getContentShape :: forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> Element -> P m (Maybe Integer, Element)
getContentShape [(Text, Text)]
ns Element
spTreeElem
| [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
"p" Text
"spTree" Element
spTreeElem = do
ph@Placeholder{index, placeholderType} <- (WriterEnv -> Placeholder)
-> ReaderT WriterEnv (StateT WriterState m) Placeholder
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Placeholder
envPlaceholder
case drop index (getShapesByPlaceHolderType ns spTreeElem placeholderType) of
Element
sp : [Element]
_ -> let
shapeId :: Maybe Integer
shapeId = [(Text, Text)] -> Element -> Maybe Text
getShapeId [(Text, Text)]
ns Element
sp Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
readTextAsInteger
in (Maybe Integer, Element)
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe Integer, Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer
shapeId, Element
sp)
[] -> PandocError
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe Integer, Element)
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe Integer, Element))
-> PandocError
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe Integer, Element)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ Placeholder -> Text
missingPlaceholderMessage Placeholder
ph
getContentShape [(Text, Text)]
_ Element
_ = PandocError
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe Integer, Element)
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe Integer, Element))
-> PandocError
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe Integer, Element)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError
Text
"Attempted to find content on non shapeTree"
missingPlaceholderMessage :: Placeholder -> Text
missingPlaceholderMessage :: Placeholder -> Text
missingPlaceholderMessage Placeholder{Int
PHType
placeholderType :: Placeholder -> PHType
index :: Placeholder -> Int
placeholderType :: PHType
index :: Int
..} =
Text
"Could not find a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ordinal
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" placeholder of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
placeholderText
where
ordinal :: Text
ordinal = FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
index) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
case (Int
index Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100, Int
index Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10) of
(Int
11, Int
_) -> Text
"th"
(Int
12, Int
_) -> Text
"th"
(Int
13, Int
_) -> Text
"th"
(Int
_, Int
1) -> Text
"st"
(Int
_, Int
2) -> Text
"nd"
(Int
_, Int
3) -> Text
"rd"
(Int, Int)
_ -> Text
"th"
placeholderText :: Text
placeholderText = case PHType
placeholderType of
PHType
ObjType -> Text
"obj (or nothing)"
PHType Text
t -> Text
t
getShapeDimensions :: NameSpaces
-> Element
-> Maybe ((Integer, Integer), (Integer, Integer))
getShapeDimensions :: [(Text, Text)]
-> Element -> Maybe ((Integer, Integer), (Integer, Integer))
getShapeDimensions [(Text, Text)]
ns Element
element
| [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
"p" Text
"sp" Element
element = do
spPr <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spPr") Element
element
xfrm <- findChild (elemName ns "a" "xfrm") spPr
off <- findChild (elemName ns "a" "off") xfrm
xS <- findAttr (QName "x" Nothing Nothing) off
yS <- findAttr (QName "y" Nothing Nothing) off
ext <- findChild (elemName ns "a" "ext") xfrm
cxS <- findAttr (QName "cx" Nothing Nothing) ext
cyS <- findAttr (QName "cy" Nothing Nothing) ext
x <- readTextAsInteger xS
y <- readTextAsInteger yS
cx <- readTextAsInteger cxS
cy <- readTextAsInteger cyS
return ((x `div` 12700, y `div` 12700),
(cx `div` 12700, cy `div` 12700))
| Bool
otherwise = Maybe ((Integer, Integer), (Integer, Integer))
forall a. Maybe a
Nothing
getMasterShapeDimensionsById :: T.Text
-> Element
-> Maybe ((Integer, Integer), (Integer, Integer))
getMasterShapeDimensionsById :: Text -> Element -> Maybe ((Integer, Integer), (Integer, Integer))
getMasterShapeDimensionsById Text
ident Element
master = do
let ns :: [(Text, Text)]
ns = Element -> [(Text, Text)]
elemToNameSpaces Element
master
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
master
spTree <- findChild (elemName ns "p" "spTree") cSld
sp <- filterChild (\Element
e -> [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
"p" Text
"sp" Element
e Bool -> Bool -> Bool
&& [(Text, Text)] -> Text -> Element -> Bool
shapeHasId [(Text, Text)]
ns Text
ident Element
e) spTree
getShapeDimensions ns sp
getContentShapeSize :: PandocMonad m
=> NameSpaces
-> Element
-> Element
-> P m ((Integer, Integer), (Integer, Integer))
getContentShapeSize :: forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)]
-> Element
-> Element
-> P m ((Integer, Integer), (Integer, Integer))
getContentShapeSize [(Text, Text)]
ns Element
layout Element
master
| [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
"p" Text
"sldLayout" Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld = do
(_, sp) <- [(Text, Text)] -> Element -> P m (Maybe Integer, Element)
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> Element -> P m (Maybe Integer, Element)
getContentShape [(Text, Text)]
ns Element
spTree
case getShapeDimensions ns sp of
Just ((Integer, Integer), (Integer, Integer))
sz -> ((Integer, Integer), (Integer, Integer))
-> ReaderT
WriterEnv
(StateT WriterState m)
((Integer, Integer), (Integer, Integer))
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Integer), (Integer, Integer))
sz
Maybe ((Integer, Integer), (Integer, Integer))
Nothing -> do let mbSz :: Maybe ((Integer, Integer), (Integer, Integer))
mbSz =
QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"nvSpPr") Element
sp Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cNvPr") Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"id" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Maybe Text
-> (Text -> Maybe ((Integer, Integer), (Integer, Integer)))
-> Maybe ((Integer, Integer), (Integer, Integer))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Text -> Element -> Maybe ((Integer, Integer), (Integer, Integer)))
-> Element
-> Text
-> Maybe ((Integer, Integer), (Integer, Integer))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Element -> Maybe ((Integer, Integer), (Integer, Integer))
getMasterShapeDimensionsById Element
master
case Maybe ((Integer, Integer), (Integer, Integer))
mbSz of
Just ((Integer, Integer), (Integer, Integer))
sz' -> ((Integer, Integer), (Integer, Integer))
-> ReaderT
WriterEnv
(StateT WriterState m)
((Integer, Integer), (Integer, Integer))
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Integer), (Integer, Integer))
sz'
Maybe ((Integer, Integer), (Integer, Integer))
Nothing -> PandocError
-> ReaderT
WriterEnv
(StateT WriterState m)
((Integer, Integer), (Integer, Integer))
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError
-> ReaderT
WriterEnv
(StateT WriterState m)
((Integer, Integer), (Integer, Integer)))
-> PandocError
-> ReaderT
WriterEnv
(StateT WriterState m)
((Integer, Integer), (Integer, Integer))
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError
Text
"Couldn't find necessary content shape size"
getContentShapeSize [(Text, Text)]
_ Element
_ Element
_ = PandocError
-> ReaderT
WriterEnv
(StateT WriterState m)
((Integer, Integer), (Integer, Integer))
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError
-> ReaderT
WriterEnv
(StateT WriterState m)
((Integer, Integer), (Integer, Integer)))
-> PandocError
-> ReaderT
WriterEnv
(StateT WriterState m)
((Integer, Integer), (Integer, Integer))
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError
Text
"Attempted to find content shape size in non-layout"
buildSpTree :: NameSpaces -> Element -> [Content] -> Element
buildSpTree :: [(Text, Text)] -> Element -> [Content] -> Element
buildSpTree [(Text, Text)]
ns Element
spTreeElem [Content]
newShapes =
Element
emptySpTreeElem { elContent = newContent }
where newContent :: [Content]
newContent = Element -> [Content]
elContent Element
emptySpTreeElem [Content] -> [Content] -> [Content]
forall a. Semigroup a => a -> a -> a
<> [Content]
newShapes
emptySpTreeElem :: Element
emptySpTreeElem = Element
spTreeElem { elContent = filter fn (elContent spTreeElem) }
fn :: Content -> Bool
fn :: Content -> Bool
fn (Elem Element
e) = [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
"p" Text
"nvGrpSpPr" Element
e Bool -> Bool -> Bool
||
[(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
"p" Text
"grpSpPr" Element
e
fn Content
_ = Bool
True
replaceNamedChildren :: NameSpaces
-> Text
-> Text
-> [Element]
-> Element
-> Element
replaceNamedChildren :: [(Text, Text)] -> Text -> Text -> [Element] -> Element -> Element
replaceNamedChildren [(Text, Text)]
ns Text
prefix Text
name [Element]
newKids Element
element =
Element
element { elContent = concat $ fun True $ elContent element }
where
fun :: Bool -> [Content] -> [[Content]]
fun :: Bool -> [Content] -> [[Content]]
fun Bool
_ [] = []
fun Bool
switch (Elem Element
e : [Content]
conts) | [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
prefix Text
name Element
e =
if Bool
switch
then (Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
newKids [Content] -> [[Content]] -> [[Content]]
forall a. a -> [a] -> [a]
: Bool -> [Content] -> [[Content]]
fun Bool
False [Content]
conts
else Bool -> [Content] -> [[Content]]
fun Bool
False [Content]
conts
fun Bool
switch (Content
cont : [Content]
conts) = [Content
cont] [Content] -> [[Content]] -> [[Content]]
forall a. a -> [a] -> [a]
: Bool -> [Content] -> [[Content]]
fun Bool
switch [Content]
conts
registerLink :: PandocMonad m => LinkTarget -> P m Int
registerLink :: forall (m :: * -> *). PandocMonad m => LinkTarget -> P m Int
registerLink LinkTarget
link = do
curSlideId <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envCurSlideId
linkReg <- gets stLinkIds
mediaReg <- gets stMediaIds
hasSpeakerNotes <- curSlideHasSpeakerNotes
let maxLinkId = case Int -> Map Int (Map Int LinkTarget) -> Maybe (Map Int LinkTarget)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
curSlideId Map Int (Map Int LinkTarget)
linkReg Maybe (Map Int LinkTarget)
-> (Map Int LinkTarget -> Maybe (NonEmpty Int))
-> Maybe (NonEmpty Int)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> (Map Int LinkTarget -> [Int])
-> Map Int LinkTarget
-> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int LinkTarget -> [Int]
forall k a. Map k a -> [k]
M.keys of
Just NonEmpty Int
xs -> NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum NonEmpty Int
xs
Maybe (NonEmpty Int)
Nothing
| Bool
hasSpeakerNotes -> Int
2
| Bool
otherwise -> Int
1
maxMediaId = case Int -> Map Int [MediaInfo] -> Maybe [MediaInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
curSlideId Map Int [MediaInfo]
mediaReg Maybe [MediaInfo]
-> ([MediaInfo] -> Maybe (NonEmpty MediaInfo))
-> Maybe (NonEmpty MediaInfo)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [MediaInfo] -> Maybe (NonEmpty MediaInfo)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty of
Just NonEmpty MediaInfo
mInfos -> NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NonEmpty Int -> Int) -> NonEmpty Int -> Int
forall a b. (a -> b) -> a -> b
$ (MediaInfo -> Int) -> NonEmpty MediaInfo -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MediaInfo -> Int
mInfoLocalId NonEmpty MediaInfo
mInfos
Maybe (NonEmpty MediaInfo)
Nothing
| Bool
hasSpeakerNotes -> Int
2
| Bool
otherwise -> Int
1
maxId = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
maxLinkId Int
maxMediaId
slideLinks = case Int -> Map Int (Map Int LinkTarget) -> Maybe (Map Int LinkTarget)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
curSlideId Map Int (Map Int LinkTarget)
linkReg of
Just Map Int LinkTarget
mp -> Int -> LinkTarget -> Map Int LinkTarget -> Map Int LinkTarget
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Int
maxId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) LinkTarget
link Map Int LinkTarget
mp
Maybe (Map Int LinkTarget)
Nothing -> Int -> LinkTarget -> Map Int LinkTarget
forall k a. k -> a -> Map k a
M.singleton (Int
maxId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) LinkTarget
link
modify $ \WriterState
st -> WriterState
st{ stLinkIds = M.insert curSlideId slideLinks linkReg}
return $ maxId + 1
registerMedia :: PandocMonad m => FilePath -> [ParaElem] -> P m MediaInfo
registerMedia :: forall (m :: * -> *).
PandocMonad m =>
FilePath -> [ParaElem] -> P m MediaInfo
registerMedia FilePath
fp [ParaElem]
caption = do
curSlideId <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envCurSlideId
linkReg <- gets stLinkIds
mediaReg <- gets stMediaIds
globalIds <- gets stMediaGlobalIds
hasSpeakerNotes <- curSlideHasSpeakerNotes
let maxLinkId = case Int -> Map Int (Map Int LinkTarget) -> Maybe (Map Int LinkTarget)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
curSlideId Map Int (Map Int LinkTarget)
linkReg Maybe (Map Int LinkTarget)
-> (Map Int LinkTarget -> Maybe (NonEmpty Int))
-> Maybe (NonEmpty Int)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> (Map Int LinkTarget -> [Int])
-> Map Int LinkTarget
-> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int LinkTarget -> [Int]
forall k a. Map k a -> [k]
M.keys of
Just NonEmpty Int
ks -> NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum NonEmpty Int
ks
Maybe (NonEmpty Int)
Nothing
| Bool
hasSpeakerNotes -> Int
2
| Bool
otherwise -> Int
1
maxMediaId = case Int -> Map Int [MediaInfo] -> Maybe [MediaInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
curSlideId Map Int [MediaInfo]
mediaReg Maybe [MediaInfo]
-> ([MediaInfo] -> Maybe (NonEmpty MediaInfo))
-> Maybe (NonEmpty MediaInfo)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [MediaInfo] -> Maybe (NonEmpty MediaInfo)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty of
Just NonEmpty MediaInfo
mInfos -> NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NonEmpty Int -> Int) -> NonEmpty Int -> Int
forall a b. (a -> b) -> a -> b
$ (MediaInfo -> Int) -> NonEmpty MediaInfo -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MediaInfo -> Int
mInfoLocalId NonEmpty MediaInfo
mInfos
Maybe (NonEmpty MediaInfo)
Nothing
| Bool
hasSpeakerNotes -> Int
2
| Bool
otherwise -> Int
1
maxLocalId = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
maxLinkId Int
maxMediaId
maxGlobalId = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ Map FilePath Int -> [Int]
forall k a. Map k a -> [a]
M.elems Map FilePath Int
globalIds
(imgBytes, mbMt) <- P.fetchItem $ T.pack fp
let imgExt = (Maybe Text
mbMt Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
extensionFromMimeType Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x))
Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
case StrictByteString -> Maybe ImageType
imageType StrictByteString
imgBytes of
Just ImageType
Png -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".png"
Just ImageType
Jpeg -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".jpeg"
Just ImageType
Gif -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".gif"
Just ImageType
Pdf -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".pdf"
Just ImageType
Eps -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".eps"
Just ImageType
Svg -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".svg"
Just ImageType
Emf -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".emf"
Just ImageType
Tiff -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".tiff"
Just ImageType
Webp -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".webp"
Maybe ImageType
Nothing -> Maybe Text
forall a. Maybe a
Nothing
let newGlobalId = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int
maxGlobalId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (FilePath -> Map FilePath Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
fp Map FilePath Int
globalIds)
let newGlobalIds = FilePath -> Int -> Map FilePath Int -> Map FilePath Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
fp Int
newGlobalId Map FilePath Int
globalIds
let mediaInfo = MediaInfo { mInfoFilePath :: FilePath
mInfoFilePath = FilePath
fp
, mInfoLocalId :: Int
mInfoLocalId = Int
maxLocalId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, mInfoGlobalId :: Int
mInfoGlobalId = Int
newGlobalId
, mInfoMimeType :: Maybe Text
mInfoMimeType =
case Maybe Text
mbMt of
Just Text
t | Text
";base64" Text -> Text -> Bool
`T.isSuffixOf` Text
t
-> Text -> Text -> Maybe Text
T.stripSuffix Text
";base64" Text
t
Maybe Text
x -> Maybe Text
x
, mInfoExt :: Maybe Text
mInfoExt = Maybe Text
imgExt
, mInfoCaption :: Bool
mInfoCaption = (Bool -> Bool
not (Bool -> Bool) -> ([ParaElem] -> Bool) -> [ParaElem] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [ParaElem]
caption
}
let slideMediaInfos = case Int -> Map Int [MediaInfo] -> Maybe [MediaInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
curSlideId Map Int [MediaInfo]
mediaReg of
Just [MediaInfo]
minfos -> MediaInfo
mediaInfo MediaInfo -> [MediaInfo] -> [MediaInfo]
forall a. a -> [a] -> [a]
: [MediaInfo]
minfos
Maybe [MediaInfo]
Nothing -> [MediaInfo
mediaInfo]
modify $ \WriterState
st -> WriterState
st{ stMediaIds = M.insert curSlideId slideMediaInfos mediaReg
, stMediaGlobalIds = newGlobalIds
}
return mediaInfo
makeMediaEntry :: PandocMonad m => MediaInfo -> P m Entry
makeMediaEntry :: forall (m :: * -> *). PandocMonad m => MediaInfo -> P m Entry
makeMediaEntry MediaInfo
mInfo = do
epochtime <- POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> Integer)
-> ReaderT WriterEnv (StateT WriterState m) UTCTime
-> ReaderT WriterEnv (StateT WriterState m) Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterEnv -> UTCTime)
-> ReaderT WriterEnv (StateT WriterState m) UTCTime
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> UTCTime
envUTCTime
(imgBytes, _) <- P.fetchItem (T.pack $ mInfoFilePath mInfo)
let ext = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (MediaInfo -> Maybe Text
mInfoExt MediaInfo
mInfo)
let fp = FilePath
"ppt/media/image" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
Int -> FilePath
forall a. Show a => a -> FilePath
show (MediaInfo -> Int
mInfoGlobalId MediaInfo
mInfo) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
ext
return $ toEntry fp epochtime $ BL.fromStrict imgBytes
makeMediaEntries :: PandocMonad m => P m [Entry]
makeMediaEntries :: forall (m :: * -> *). PandocMonad m => P m [Entry]
makeMediaEntries = do
mediaInfos <- (WriterState -> Map Int [MediaInfo])
-> ReaderT WriterEnv (StateT WriterState m) (Map Int [MediaInfo])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int [MediaInfo]
stMediaIds
let allInfos = [[MediaInfo]] -> [MediaInfo]
forall a. Monoid a => [a] -> a
mconcat ([[MediaInfo]] -> [MediaInfo]) -> [[MediaInfo]] -> [MediaInfo]
forall a b. (a -> b) -> a -> b
$ Map Int [MediaInfo] -> [[MediaInfo]]
forall k a. Map k a -> [a]
M.elems Map Int [MediaInfo]
mediaInfos
mapM makeMediaEntry allInfos
getMaster :: PandocMonad m => P m Element
getMaster :: forall (m :: * -> *). PandocMonad m => P m Element
getMaster = do
refArchive <- (WriterEnv -> Archive)
-> ReaderT WriterEnv (StateT WriterState m) Archive
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
distArchive <- asks envDistArchive
getMaster' refArchive distArchive
getMaster' :: PandocMonad m => Archive -> Archive -> m Element
getMaster' :: forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> m Element
getMaster' Archive
refArchive Archive
distArchive =
Archive -> Archive -> FilePath -> m Element
forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> FilePath -> m Element
parseXml Archive
refArchive Archive
distArchive FilePath
"ppt/slideMasters/slideMaster1.xml"
getMasterRels :: PandocMonad m => P m Element
getMasterRels :: forall (m :: * -> *). PandocMonad m => P m Element
getMasterRels = do
refArchive <- (WriterEnv -> Archive)
-> ReaderT WriterEnv (StateT WriterState m) Archive
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
distArchive <- asks envDistArchive
parseXml refArchive distArchive "ppt/slideMasters/_rels/slideMaster1.xml.rels"
captionHeight :: Integer
captionHeight :: Integer
captionHeight = Integer
40
createCaption :: PandocMonad m
=> ((Integer, Integer), (Integer, Integer))
-> [ParaElem]
-> P m (ShapeId, Element)
createCaption :: forall (m :: * -> *).
PandocMonad m =>
((Integer, Integer), (Integer, Integer))
-> [ParaElem] -> P m (Integer, Element)
createCaption ((Integer, Integer), (Integer, Integer))
contentShapeDimensions [ParaElem]
paraElements = do
let para :: Paragraph
para = ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
forall a. Default a => a
def{pPropAlign = Just AlgnCenter} [ParaElem]
paraElements
elements <- (Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element)
-> [Paragraph]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element
forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
paragraphToElement [Paragraph
para]
let ((x, y), (cx, cy)) = contentShapeDimensions
let txBody = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:txBody" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:bodyPr" [] (), Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<> [Element]
elements
return
( 1
, surroundWithMathAlternate $
mknode "p:sp" [] [ mknode "p:nvSpPr" []
[ mknode "p:cNvPr" [("id","1"), ("name","TextBox 3")] ()
, mknode "p:cNvSpPr" [("txBox", "1")] ()
, mknode "p:nvPr" [] ()
]
, mknode "p:spPr" []
[ mknode "a:xfrm" []
[ mknode "a:off" [("x", tshow $ 12700 * x),
("y", tshow $ 12700 * (y + cy - captionHeight))] ()
, mknode "a:ext" [("cx", tshow $ 12700 * cx),
("cy", tshow $ 12700 * captionHeight)] ()
]
, mknode "a:prstGeom" [("prst", "rect")]
[ mknode "a:avLst" [] ()
]
, mknode "a:noFill" [] ()
]
, txBody
]
)
makePicElements :: PandocMonad m
=> Element
-> PicProps
-> MediaInfo
-> Text
-> [ParaElem]
-> P m [(ShapeId, Element)]
makePicElements :: forall (m :: * -> *).
PandocMonad m =>
Element
-> PicProps
-> MediaInfo
-> Text
-> [ParaElem]
-> P m [(Integer, Element)]
makePicElements Element
layout PicProps
picProps MediaInfo
mInfo Text
titleText [ParaElem]
alt = do
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (StateT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
(pageWidth, pageHeight) <- asks envPresentationSize
let hasCaption = MediaInfo -> Bool
mInfoCaption MediaInfo
mInfo
(imgBytes, _) <- P.fetchItem (T.pack $ mInfoFilePath mInfo)
let (pxX, pxY) = case imageSize opts imgBytes of
Right ImageSize
sz -> ImageSize -> (Integer, Integer)
sizeInPixels ImageSize
sz
Left Text
_ -> ImageSize -> (Integer, Integer)
sizeInPixels ImageSize
forall a. Default a => a
def
master <- getMaster
let ns = Element -> [(Text, Text)]
elemToNameSpaces Element
layout
((x, y), (cx, cytmp)) <- getContentShapeSize ns layout master
`catchError`
(\PandocError
_ -> ((Integer, Integer), (Integer, Integer))
-> P m ((Integer, Integer), (Integer, Integer))
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer
0, Integer
0), (Integer
pageWidth, Integer
pageHeight)))
let cy = if Bool
hasCaption then Integer
cytmp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
captionHeight else Integer
cytmp
let imgRatio = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pxX Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pxY :: Double
boxRatio = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
cx Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
cy :: Double
(dimX, dimY) = if imgRatio > boxRatio
then (fromIntegral cx, fromIntegral cx / imgRatio)
else (fromIntegral cy * imgRatio, fromIntegral cy)
(dimX', dimY') = (round dimX * 12700, round dimY * 12700) :: (Integer, Integer)
(xoff, yoff) = (fromIntegral x + (fromIntegral cx - dimX) / 2,
fromIntegral y + (fromIntegral cy - dimY) / 2)
(xoff', yoff') = (round xoff * 12700, round yoff * 12700) :: (Integer, Integer)
let cNvPicPr = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cNvPicPr" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:picLocks" [(Text
"noGrp",Text
"1")
,(Text
"noChangeAspect",Text
"1")] ()
let description = (if Text -> Bool
T.null Text
titleText
then Text
""
else Text
titleText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n")
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (MediaInfo -> FilePath
mInfoFilePath MediaInfo
mInfo)
let cNvPrAttr = [(Text
"descr", Text
description),
(Text
"id",Text
"0"),
(Text
"name",Text
"Picture 1")]
cNvPr <- case picPropLink picProps of
Just LinkTarget
link -> do idNum <- LinkTarget -> P m Int
forall (m :: * -> *). PandocMonad m => LinkTarget -> P m Int
registerLink LinkTarget
link
return $ mknode "p:cNvPr" cNvPrAttr $
mknode "a:hlinkClick" [("r:id", "rId" <> tshow idNum)] ()
Maybe LinkTarget
Nothing -> Element -> P m Element
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> P m Element) -> Element -> P m Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cNvPr" [(Text, Text)]
cNvPrAttr ()
let nvPicPr = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:nvPicPr" []
[ Element
cNvPr
, Element
cNvPicPr
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:nvPr" [] ()]
let blipFill = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:blipFill" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:blip" [(Text
"r:embed", Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Int -> Text
forall a. Show a => a -> Text
tshow (MediaInfo -> Int
mInfoLocalId MediaInfo
mInfo))] ()
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:stretch" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:fillRect" [] () ]
let xfrm = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:xfrm" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:off" [(Text
"x", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
xoff'), (Text
"y", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
yoff')] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ext" [(Text
"cx", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
dimX')
,(Text
"cy", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
dimY')] () ]
let prstGeom = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:prstGeom" [(Text
"prst",Text
"rect")] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:avLst" [] ()
let ln = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ln" [(Text
"w",Text
"9525")]
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:noFill" [] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:headEnd" [] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tailEnd" [] () ]
let spPr = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:spPr" [(Text
"bwMode",Text
"auto")]
[Element
xfrm, Element
prstGeom, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:noFill" [] (), Element
ln]
let picShape = ( Integer
0
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:pic" []
[ Element
nvPicPr
, Element
blipFill
, Element
spPr ]
)
if hasCaption
then do cap <- createCaption ((x, y), (cx, cytmp)) alt
return [picShape, cap]
else return [picShape]
consolidateRuns :: [ParaElem] -> [ParaElem]
consolidateRuns :: [ParaElem] -> [ParaElem]
consolidateRuns [] = []
consolidateRuns (Run RunProps
pr1 Text
s1 : Run RunProps
pr2 Text
s2 : [ParaElem]
xs)
| RunProps
pr1 RunProps -> RunProps -> Bool
forall a. Eq a => a -> a -> Bool
== RunProps
pr2 = [ParaElem] -> [ParaElem]
consolidateRuns (RunProps -> Text -> ParaElem
Run RunProps
pr1 (Text
s1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s2) ParaElem -> [ParaElem] -> [ParaElem]
forall a. a -> [a] -> [a]
: [ParaElem]
xs)
consolidateRuns (ParaElem
x:[ParaElem]
xs) = ParaElem
x ParaElem -> [ParaElem] -> [ParaElem]
forall a. a -> [a] -> [a]
: [ParaElem] -> [ParaElem]
consolidateRuns [ParaElem]
xs
paraElemToElements :: PandocMonad m => ParaElem -> P m [Content]
paraElemToElements :: forall (m :: * -> *). PandocMonad m => ParaElem -> P m [Content]
paraElemToElements ParaElem
Break = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:br" [] ()]
paraElemToElements (Run RunProps
rpr Text
s) = do
sizeAttrs <- RunProps -> P m [(Text, Text)]
forall (m :: * -> *). Monad m => RunProps -> P m [(Text, Text)]
fontSizeAttributes RunProps
rpr
let attrs = [(Text, Text)]
sizeAttrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
(
[(Text
"b", Text
"1") | RunProps -> Bool
rPropBold RunProps
rpr]) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
(
[(Text
"i", Text
"1") | RunProps -> Bool
rPropItalics RunProps
rpr]) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
(
[(Text
"u", Text
"sng") | RunProps -> Bool
rPropUnderline RunProps
rpr]) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
(case RunProps -> Maybe Strikethrough
rStrikethrough RunProps
rpr of
Just Strikethrough
NoStrike -> [(Text
"strike", Text
"noStrike")]
Just Strikethrough
SingleStrike -> [(Text
"strike", Text
"sngStrike")]
Just Strikethrough
DoubleStrike -> [(Text
"strike", Text
"dblStrike")]
Maybe Strikethrough
Nothing -> []) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
(case RunProps -> Maybe Int
rBaseline RunProps
rpr of
Just Int
n -> [(Text
"baseline", Int -> Text
forall a. Show a => a -> Text
tshow Int
n)]
Maybe Int
Nothing -> []) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
(case RunProps -> Maybe Capitals
rCap RunProps
rpr of
Just Capitals
NoCapitals -> [(Text
"cap", Text
"none")]
Just Capitals
SmallCapitals -> [(Text
"cap", Text
"small")]
Just Capitals
AllCapitals -> [(Text
"cap", Text
"all")]
Maybe Capitals
Nothing -> []) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
[]
linkProps <- case rLink rpr of
Just LinkTarget
link -> do
idNum <- LinkTarget -> P m Int
forall (m :: * -> *). PandocMonad m => LinkTarget -> P m Int
registerLink LinkTarget
link
return $ case link of
InternalTarget SlideId
_ ->
let linkAttrs :: [(Text, Text)]
linkAttrs =
[ (Text
"r:id", Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
idNum)
, (Text
"action", Text
"ppaction://hlinksldjump")
]
in [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:hlinkClick" [(Text, Text)]
linkAttrs ()]
ExternalTarget (Text, Text)
_ ->
let linkAttrs :: [(Text, Text)]
linkAttrs =
[ (Text
"r:id", Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
idNum)
]
in [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:hlinkClick" [(Text, Text)]
linkAttrs ()]
Maybe LinkTarget
Nothing -> [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
let colorContents = case RunProps -> Maybe Color
rSolidFill RunProps
rpr of
Just Color
color ->
case Color -> FilePath
forall a. FromColor a => Color -> a
fromColor Color
color of
Char
'#':FilePath
hx ->
[Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:solidFill" []
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:srgbClr"
[(Text
"val", Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
hx)] ()]]
FilePath
_ -> []
Maybe Color
Nothing -> []
codeFont <- monospaceFont
let codeContents =
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:latin" [(Text
"typeface", Text
codeFont)] () | RunProps -> Bool
rPropCode RunProps
rpr]
let propContents = [Element]
linkProps [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<> [Element]
colorContents [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<> [Element]
codeContents
return [Elem $ mknode "a:r" [] [ mknode "a:rPr" attrs propContents
, mknode "a:t" [] s
]]
paraElemToElements (MathElem MathType
mathType TeXString
texStr) = do
isInSpkrNotes <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInSpeakerNotes
if isInSpkrNotes
then paraElemToElements $ Run def $ unTeXString texStr
else do res <- convertMath writeOMML mathType (unTeXString texStr)
case fromXLElement <$> res of
Right Element
r -> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a14:m" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element -> Element
addMathInfo Element
r]
Left (Str Text
s) -> ParaElem -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *). PandocMonad m => ParaElem -> P m [Content]
paraElemToElements (RunProps -> Text -> ParaElem
Run RunProps
forall a. Default a => a
def Text
s)
Left Inline
_ -> PandocError -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> PandocError
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError Text
"non-string math fallback"
paraElemToElements (RawOOXMLParaElem Text
str) = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return
[CData -> Content
Text (CDataKind -> Text -> Maybe Integer -> CData
CData CDataKind
CDataRaw Text
str Maybe Integer
forall a. Maybe a
Nothing)]
addMathInfo :: Element -> Element
addMathInfo :: Element -> Element
addMathInfo Element
element =
let mathspace :: Attr
mathspace =
Attr { attrKey :: QName
attrKey = Text -> Maybe Text -> Maybe Text -> QName
QName Text
"m" Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"xmlns")
, attrVal :: Text
attrVal = Text
"http://schemas.openxmlformats.org/officeDocument/2006/math"
}
in Attr -> Element -> Element
add_attr Attr
mathspace Element
element
surroundWithMathAlternate :: Element -> Element
surroundWithMathAlternate :: Element -> Element
surroundWithMathAlternate Element
element =
case QName -> Element -> Maybe Element
findElement (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"m" Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"a14")) Element
element of
Just Element
_ ->
Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"mc:AlternateContent"
[(Text
"xmlns:mc", Text
"http://schemas.openxmlformats.org/markup-compatibility/2006")
] [ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"mc:Choice"
[ (Text
"xmlns:a14", Text
"http://schemas.microsoft.com/office/drawing/2010/main")
, (Text
"Requires", Text
"a14")] [ Element
element ]
]
Maybe Element
Nothing -> Element
element
paragraphToElement :: PandocMonad m => Paragraph -> P m Element
paragraphToElement :: forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
paragraphToElement Paragraph
par = do
indents <- (WriterEnv -> Maybe Indents)
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Indents)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Maybe Indents
envOtherStyleIndents
let
lvl = ParaProps -> Int
pPropLevel (Paragraph -> ParaProps
paraProps Paragraph
par)
attrs = [(Text
"lvl", Int -> Text
forall a. Show a => a -> Text
tshow Int
lvl)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
(case (ParaProps -> Maybe Integer
pPropIndent (Paragraph -> ParaProps
paraProps Paragraph
par), ParaProps -> Maybe Integer
pPropMarginLeft (Paragraph -> ParaProps
paraProps Paragraph
par)) of
(Just Integer
px1, Just Integer
px2) -> [ (Text
"indent", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
pixelsToEmu Integer
px1)
, (Text
"marL", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
pixelsToEmu Integer
px2)
]
(Just Integer
px1, Maybe Integer
Nothing) -> [(Text
"indent", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
pixelsToEmu Integer
px1)]
(Maybe Integer
Nothing, Just Integer
px2) -> [(Text
"marL", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
pixelsToEmu Integer
px2)]
(Maybe Integer
Nothing, Maybe Integer
Nothing) -> [(Text, Text)] -> Maybe [(Text, Text)] -> [(Text, Text)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(Text, Text)] -> [(Text, Text)])
-> Maybe [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ do
indents' <- Maybe Indents
indents
thisLevel <- levelIndent indents' lvl
nextLevel <- levelIndent indents' (lvl + 1)
let (m, i) =
case pPropBullet (paraProps par) of
Maybe BulletType
Nothing ->
(Integer -> Maybe Integer
forall a. a -> Maybe a
Just (LevelIndents -> Integer
marL LevelIndents
thisLevel), Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0)
Just (AutoNumbering ListAttributes
_) ->
( Integer -> Maybe Integer
forall a. a -> Maybe a
Just (LevelIndents -> Integer
marL LevelIndents
nextLevel)
, Integer -> Maybe Integer
forall a. a -> Maybe a
Just (LevelIndents -> Integer
marL LevelIndents
thisLevel Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- LevelIndents -> Integer
marL LevelIndents
nextLevel)
)
Just BulletType
Bullet -> (Maybe Integer
forall a. Maybe a
Nothing, Maybe Integer
forall a. Maybe a
Nothing)
pure ( toList ((,) "indent" . tshow <$> i)
<> toList ((,) "marL" . tshow <$> m)
)
) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
(case ParaProps -> Maybe Algnment
pPropAlign (Paragraph -> ParaProps
paraProps Paragraph
par) of
Just Algnment
AlgnLeft -> [(Text
"algn", Text
"l")]
Just Algnment
AlgnRight -> [(Text
"algn", Text
"r")]
Just Algnment
AlgnCenter -> [(Text
"algn", Text
"ctr")]
Maybe Algnment
Nothing -> []
)
props = [] [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<>
(case ParaProps -> Maybe Integer
pPropSpaceBefore (ParaProps -> Maybe Integer) -> ParaProps -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Paragraph -> ParaProps
paraProps Paragraph
par of
Just Integer
px -> [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:spcBef" [] [
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:spcPts" [(Text
"val", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
px)] ()
]
]
Maybe Integer
Nothing -> []
) [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<>
(case ParaProps -> Maybe BulletType
pPropBullet (ParaProps -> Maybe BulletType) -> ParaProps -> Maybe BulletType
forall a b. (a -> b) -> a -> b
$ Paragraph -> ParaProps
paraProps Paragraph
par of
Just BulletType
Bullet -> []
Just (AutoNumbering ListAttributes
attrs') ->
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:buAutoNum" (ListAttributes -> [(Text, Text)]
autoNumAttrs ListAttributes
attrs') ()]
Maybe BulletType
Nothing -> [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:buNone" [] ()]
)
paras <- mconcat <$> mapM paraElemToElements (consolidateRuns (paraElems par))
return $ mknode "a:p" [] $ [Elem $ mknode "a:pPr" attrs props] <> paras
shapeToElement :: PandocMonad m => Element -> Shape -> P m (Maybe ShapeId, Element)
shapeToElement :: forall (m :: * -> *).
PandocMonad m =>
Element -> Shape -> P m (Maybe Integer, Element)
shapeToElement Element
layout (TextBox [Paragraph]
paras)
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld = do
(shapeId, sp) <- [(Text, Text)] -> Element -> P m (Maybe Integer, Element)
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> Element -> P m (Maybe Integer, Element)
getContentShape [(Text, Text)]
ns Element
spTree
elements <- mapM paragraphToElement paras
let txBody = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:txBody" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:bodyPr" [] (), Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<> [Element]
elements
emptySpPr = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:spPr" [] ()
return
. (shapeId,)
. surroundWithMathAlternate
. replaceNamedChildren ns "p" "txBody" [txBody]
. replaceNamedChildren ns "p" "spPr" [emptySpPr]
$ sp
shapeToElement Element
_ Shape
_ = (Maybe Integer, Element) -> P m (Maybe Integer, Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer
forall a. Maybe a
Nothing, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" [] ())
shapeToElements :: PandocMonad m => Element -> Shape -> P m [(Maybe ShapeId, Content)]
shapeToElements :: forall (m :: * -> *).
PandocMonad m =>
Element -> Shape -> P m [(Maybe Integer, Content)]
shapeToElements Element
layout (Pic PicProps
picProps FilePath
fp Text
titleText [ParaElem]
alt) = do
mInfo <- FilePath -> [ParaElem] -> P m MediaInfo
forall (m :: * -> *).
PandocMonad m =>
FilePath -> [ParaElem] -> P m MediaInfo
registerMedia FilePath
fp [ParaElem]
alt
case mInfoExt mInfo of
Just Text
_ -> ((Integer, Element) -> (Maybe Integer, Content))
-> [(Integer, Element)] -> [(Maybe Integer, Content)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Maybe Integer)
-> (Element -> Content)
-> (Integer, Element)
-> (Maybe Integer, Content)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Integer -> Maybe Integer
forall a. a -> Maybe a
Just Element -> Content
Elem) ([(Integer, Element)] -> [(Maybe Integer, Content)])
-> ReaderT WriterEnv (StateT WriterState m) [(Integer, Element)]
-> ReaderT
WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Element
-> PicProps
-> MediaInfo
-> Text
-> [ParaElem]
-> ReaderT WriterEnv (StateT WriterState m) [(Integer, Element)]
forall (m :: * -> *).
PandocMonad m =>
Element
-> PicProps
-> MediaInfo
-> Text
-> [ParaElem]
-> P m [(Integer, Element)]
makePicElements Element
layout PicProps
picProps MediaInfo
mInfo Text
titleText [ParaElem]
alt
Maybe Text
Nothing -> Element
-> Shape
-> ReaderT
WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
forall (m :: * -> *).
PandocMonad m =>
Element -> Shape -> P m [(Maybe Integer, Content)]
shapeToElements Element
layout (Shape
-> ReaderT
WriterEnv (StateT WriterState m) [(Maybe Integer, Content)])
-> Shape
-> ReaderT
WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
forall a b. (a -> b) -> a -> b
$ [Paragraph] -> Shape
TextBox [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
forall a. Default a => a
def [ParaElem]
alt]
shapeToElements Element
layout (GraphicFrame [Graphic]
tbls [ParaElem]
cptn) = ((Integer, Element) -> (Maybe Integer, Content))
-> [(Integer, Element)] -> [(Maybe Integer, Content)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Maybe Integer)
-> (Element -> Content)
-> (Integer, Element)
-> (Maybe Integer, Content)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Integer -> Maybe Integer
forall a. a -> Maybe a
Just Element -> Content
Elem) ([(Integer, Element)] -> [(Maybe Integer, Content)])
-> ReaderT WriterEnv (StateT WriterState m) [(Integer, Element)]
-> ReaderT
WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Element
-> [Graphic]
-> [ParaElem]
-> ReaderT WriterEnv (StateT WriterState m) [(Integer, Element)]
forall (m :: * -> *).
PandocMonad m =>
Element -> [Graphic] -> [ParaElem] -> P m [(Integer, Element)]
graphicFrameToElements Element
layout [Graphic]
tbls [ParaElem]
cptn
shapeToElements Element
_ (RawOOXMLShape Text
str) = [(Maybe Integer, Content)]
-> ReaderT
WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return
[(Maybe Integer
forall a. Maybe a
Nothing, CData -> Content
Text (CDataKind -> Text -> Maybe Integer -> CData
CData CDataKind
CDataRaw Text
str Maybe Integer
forall a. Maybe a
Nothing))]
shapeToElements Element
layout shp :: Shape
shp@(TextBox [Paragraph]
_) = do
(shapeId, element) <- Element -> Shape -> P m (Maybe Integer, Element)
forall (m :: * -> *).
PandocMonad m =>
Element -> Shape -> P m (Maybe Integer, Element)
shapeToElement Element
layout Shape
shp
return [(shapeId, Elem element)]
shapesToElements :: PandocMonad m => Element -> [Shape] -> P m [(Maybe ShapeId, Content)]
shapesToElements :: forall (m :: * -> *).
PandocMonad m =>
Element -> [Shape] -> P m [(Maybe Integer, Content)]
shapesToElements Element
layout [Shape]
shps =
[[(Maybe Integer, Content)]] -> [(Maybe Integer, Content)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Maybe Integer, Content)]] -> [(Maybe Integer, Content)])
-> ReaderT
WriterEnv (StateT WriterState m) [[(Maybe Integer, Content)]]
-> ReaderT
WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Shape
-> ReaderT
WriterEnv (StateT WriterState m) [(Maybe Integer, Content)])
-> [Shape]
-> ReaderT
WriterEnv (StateT WriterState m) [[(Maybe Integer, Content)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Element
-> Shape
-> ReaderT
WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
forall (m :: * -> *).
PandocMonad m =>
Element -> Shape -> P m [(Maybe Integer, Content)]
shapeToElements Element
layout) [Shape]
shps
graphicFrameToElements ::
PandocMonad m =>
Element ->
[Graphic] ->
[ParaElem] ->
P m [(ShapeId, Element)]
graphicFrameToElements :: forall (m :: * -> *).
PandocMonad m =>
Element -> [Graphic] -> [ParaElem] -> P m [(Integer, Element)]
graphicFrameToElements Element
layout [Graphic]
tbls [ParaElem]
caption = do
master <- P m Element
forall (m :: * -> *). PandocMonad m => P m Element
getMaster
(pageWidth, pageHeight) <- asks envPresentationSize
let ns = Element -> [(Text, Text)]
elemToNameSpaces Element
layout
((x, y), (cx, cytmp)) <- getContentShapeSize ns layout master
`catchError`
(\PandocError
_ -> ((Integer, Integer), (Integer, Integer))
-> P m ((Integer, Integer), (Integer, Integer))
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer
0, Integer
0), (Integer
pageWidth, Integer
pageHeight)))
let cy = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
caption then Integer
cytmp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
captionHeight else Integer
cytmp
elements <- mapM (graphicToElement cx) tbls
let graphicFrameElts =
( Integer
6
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:graphicFrame" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:nvGraphicFramePr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cNvPr" [(Text
"id", Text
"6"), (Text
"name", Text
"Content Placeholder 5")] ()
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cNvGraphicFramePr" []
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:graphicFrameLocks" [(Text
"noGrp", Text
"1")] ()]
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:nvPr" []
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:ph" [(Text
"idx", Text
"1")] ()]
]
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:xfrm" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:off" [(Text
"x", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
12700 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x),
(Text
"y", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
12700 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ext" [(Text
"cx", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
12700 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
cx),
(Text
"cy", Integer -> Text
forall a. Show a => a -> Text
tshow (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
12700 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
cy)] ()
]
] [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<> [Element]
elements
)
if not $ null caption
then do capElt <- createCaption ((x, y), (cx, cytmp)) caption
return [graphicFrameElts, capElt]
else return [graphicFrameElts]
getDefaultTableStyle :: PandocMonad m => P m (Maybe T.Text)
getDefaultTableStyle :: forall (m :: * -> *). PandocMonad m => P m (Maybe Text)
getDefaultTableStyle = do
refArchive <- (WriterEnv -> Archive)
-> ReaderT WriterEnv (StateT WriterState m) Archive
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
distArchive <- asks envDistArchive
tblStyleLst <- parseXml refArchive distArchive "ppt/tableStyles.xml"
return $ findAttr (QName "def" Nothing Nothing) tblStyleLst
graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element
graphicToElement :: forall (m :: * -> *).
PandocMonad m =>
Integer -> Graphic -> P m Element
graphicToElement Integer
tableWidth (Tbl [Double]
widths TableProps
tblPr [[Paragraph]]
hdrCells [[[Paragraph]]]
rows) = do
let totalWidth :: Double
totalWidth = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
let colWidths :: [Integer]
colWidths = if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0) [Double]
widths
then if [[Paragraph]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Paragraph]]
hdrCells
then case [[[Paragraph]]]
rows of
r :: [[Paragraph]]
r@([Paragraph]
_:[[Paragraph]]
_) : [[[Paragraph]]]
_ -> Int -> Integer -> [Integer]
forall a. Int -> a -> [a]
replicate ([[Paragraph]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Paragraph]]
r) (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$
Integer
tableWidth Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([[Paragraph]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Paragraph]]
r)
[]: [[[Paragraph]]]
_ -> []
[] -> []
else Int -> Integer -> [Integer]
forall a. Int -> a -> [a]
replicate ([[Paragraph]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Paragraph]]
hdrCells) (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$
Integer
tableWidth Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([[Paragraph]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Paragraph]]
hdrCells)
else (Double -> Integer) -> [Double] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
w -> Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
totalWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tableWidth) [Double]
widths
let cellToOpenXML :: [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
cellToOpenXML [Paragraph]
paras =
do elements <- (Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element)
-> [Paragraph]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element
forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
paragraphToElement [Paragraph]
paras
let elements' = if [Element] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
elements
then [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:p" [] [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:endParaRPr" [] ()]]
else [Element]
elements
return
[mknode "a:txBody" [] $
[ mknode "a:bodyPr" [] ()
, mknode "a:lstStyle" [] ()]
<> elements']
headers' <- ([Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element])
-> [[Paragraph]]
-> ReaderT WriterEnv (StateT WriterState m) [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall {m :: * -> *}.
PandocMonad m =>
[Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
cellToOpenXML [[Paragraph]]
hdrCells
rows' <- mapM (mapM cellToOpenXML) rows
let borderProps = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tcPr" [] ()
let emptyCell' = [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:p" [] [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:pPr" [] ()]]
let mkcell Bool
border [Element]
contents = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tc" []
([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (if [Element] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
contents
then [Element]
emptyCell'
else [Element]
contents) [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<> [ Element
borderProps | Bool
border ]
let mkrow Bool
border [[Element]]
cells = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tr" [(Text
"h", Text
"0")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ ([Element] -> Element) -> [[Element]] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [Element] -> Element
mkcell Bool
border) [[Element]]
cells
let mkgridcol Integer
w = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:gridCol"
[(Text
"w", Integer -> Text
forall a. Show a => a -> Text
tshow ((Integer
12700 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
w) :: Integer))] ()
let hasHeader = Bool -> Bool
not (([Paragraph] -> Bool) -> [[Paragraph]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Paragraph] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Paragraph]]
hdrCells)
mbDefTblStyle <- getDefaultTableStyle
let tblPrElt = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tblPr"
[ (Text
"firstRow", if TableProps -> Bool
tblPrFirstRow TableProps
tblPr then Text
"1" else Text
"0")
, (Text
"bandRow", if TableProps -> Bool
tblPrBandRow TableProps
tblPr then Text
"1" else Text
"0")
] (case Maybe Text
mbDefTblStyle of
Maybe Text
Nothing -> []
Just Text
sty -> [Text -> [(Text, Text)] -> Text -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tableStyleId" [] Text
sty])
return $ mknode "a:graphic" []
[mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")]
[mknode "a:tbl" [] $
[ tblPrElt
, mknode "a:tblGrid" [] (if all (==0) colWidths
then []
else map mkgridcol colWidths)
]
<> [ mkrow True headers' | hasHeader ] <> map (mkrow False) rows'
]
]
data PHType = PHType T.Text | ObjType
deriving (Int -> PHType -> FilePath -> FilePath
[PHType] -> FilePath -> FilePath
PHType -> FilePath
(Int -> PHType -> FilePath -> FilePath)
-> (PHType -> FilePath)
-> ([PHType] -> FilePath -> FilePath)
-> Show PHType
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> PHType -> FilePath -> FilePath
showsPrec :: Int -> PHType -> FilePath -> FilePath
$cshow :: PHType -> FilePath
show :: PHType -> FilePath
$cshowList :: [PHType] -> FilePath -> FilePath
showList :: [PHType] -> FilePath -> FilePath
Show, PHType -> PHType -> Bool
(PHType -> PHType -> Bool)
-> (PHType -> PHType -> Bool) -> Eq PHType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PHType -> PHType -> Bool
== :: PHType -> PHType -> Bool
$c/= :: PHType -> PHType -> Bool
/= :: PHType -> PHType -> Bool
Eq)
findPHType :: NameSpaces -> Element -> PHType -> Bool
findPHType :: [(Text, Text)] -> Element -> PHType -> Bool
findPHType [(Text, Text)]
ns Element
spElem PHType
phType
| [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
"p" Text
"sp" Element
spElem =
let mbPHElem :: Maybe Element
mbPHElem = (Element -> Maybe Element
forall a. a -> Maybe a
Just Element
spElem Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"nvSpPr") Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"nvPr") Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"ph"))
in
case Maybe Element
mbPHElem of
Just Element
phElem | (PHType Text
tp) <- PHType
phType ->
case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"type" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
phElem of
Just Text
tp' -> Text
tp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tp'
Maybe Text
Nothing -> Bool
False
Just Element
phElem | PHType
ObjType <- PHType
phType ->
case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"type" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
phElem of
Just Text
_ -> Bool
False
Maybe Text
Nothing -> Bool
True
Maybe Element
Nothing -> Bool
False
findPHType [(Text, Text)]
_ Element
_ PHType
_ = Bool
False
getShapesByPlaceHolderType :: NameSpaces -> Element -> PHType -> [Element]
getShapesByPlaceHolderType :: [(Text, Text)] -> Element -> PHType -> [Element]
getShapesByPlaceHolderType [(Text, Text)]
ns Element
spTreeElem PHType
phType
| [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [(Text, Text)]
ns Text
"p" Text
"spTree" Element
spTreeElem =
(Element -> Bool) -> Element -> [Element]
filterChildren (\Element
e -> [(Text, Text)] -> Element -> PHType -> Bool
findPHType [(Text, Text)]
ns Element
e PHType
phType) Element
spTreeElem
| Bool
otherwise = []
getShapeByPlaceHolderType :: NameSpaces -> Element -> PHType -> Maybe Element
getShapeByPlaceHolderType :: [(Text, Text)] -> Element -> PHType -> Maybe Element
getShapeByPlaceHolderType [(Text, Text)]
ns Element
spTreeElem PHType
phType =
[Element] -> Maybe Element
forall a. [a] -> Maybe a
listToMaybe ([Element] -> Maybe Element) -> [Element] -> Maybe Element
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Element -> PHType -> [Element]
getShapesByPlaceHolderType [(Text, Text)]
ns Element
spTreeElem PHType
phType
getShapeByPlaceHolderTypes :: NameSpaces -> Element -> [PHType] -> Maybe Element
getShapeByPlaceHolderTypes :: [(Text, Text)] -> Element -> [PHType] -> Maybe Element
getShapeByPlaceHolderTypes [(Text, Text)]
_ Element
_ [] = Maybe Element
forall a. Maybe a
Nothing
getShapeByPlaceHolderTypes [(Text, Text)]
ns Element
spTreeElem (PHType
s:[PHType]
ss) =
case [(Text, Text)] -> Element -> PHType -> Maybe Element
getShapeByPlaceHolderType [(Text, Text)]
ns Element
spTreeElem PHType
s of
Just Element
element -> Element -> Maybe Element
forall a. a -> Maybe a
Just Element
element
Maybe Element
Nothing -> [(Text, Text)] -> Element -> [PHType] -> Maybe Element
getShapeByPlaceHolderTypes [(Text, Text)]
ns Element
spTreeElem [PHType]
ss
nonBodyTextToElement ::
PandocMonad m =>
Element ->
[PHType] ->
[ParaElem] ->
P m (Maybe ShapeId, Element)
nonBodyTextToElement :: forall (m :: * -> *).
PandocMonad m =>
Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
nonBodyTextToElement Element
layout [PHType]
phTypes [ParaElem]
paraElements
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld
, Just Element
sp <- [(Text, Text)] -> Element -> [PHType] -> Maybe Element
getShapeByPlaceHolderTypes [(Text, Text)]
ns Element
spTree [PHType]
phTypes
, Just Element
nvSpPr <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"nvSpPr") Element
sp
, Just Element
cNvPr <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cNvPr") Element
nvSpPr
, Just Text
shapeId <- QName -> Element -> Maybe Text
findAttr (Text -> QName
nodename Text
"id") Element
cNvPr
, Right (Integer
shapeIdNum, Text
_) <- Text -> Either FilePath (Integer, Text)
forall a. Integral a => Reader a
decimal Text
shapeId = do
let hdrPara :: Paragraph
hdrPara = ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
forall a. Default a => a
def [ParaElem]
paraElements
element <- Paragraph -> P m Element
forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
paragraphToElement Paragraph
hdrPara
let txBody = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:txBody" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:bodyPr" [] (), Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<>
[Element
element]
return (Just shapeIdNum,
surroundWithMathAlternate $
replaceNamedChildren ns "p" "txBody" [txBody] sp)
| Bool
otherwise = (Maybe Integer, Element)
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe Integer, Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer
forall a. Maybe a
Nothing, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" [] ())
data ContentShapeIds = ContentShapeIds
{ :: Maybe ShapeId
, ContentShapeIds -> [Integer]
contentContentIds :: [ShapeId]
}
contentToElement ::
PandocMonad m =>
Element ->
[ParaElem] ->
[Shape] ->
P m (Maybe ContentShapeIds, Element)
contentToElement :: forall (m :: * -> *).
PandocMonad m =>
Element
-> [ParaElem] -> [Shape] -> P m (Maybe ContentShapeIds, Element)
contentToElement Element
layout [ParaElem]
hdrShape [Shape]
shapes
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld = do
(shapeId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
forall (m :: * -> *).
PandocMonad m =>
Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
nonBodyTextToElement Element
layout [Text -> PHType
PHType Text
"title"] [ParaElem]
hdrShape
let hdrShapeElements = [Element -> Content
Elem Element
element | Bool -> Bool
not ([ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrShape)]
contentHeaderId = if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrShape then Maybe Integer
forall a. Maybe a
Nothing else Maybe Integer
shapeId
content' <- local
(\WriterEnv
env -> WriterEnv
env {envPlaceholder = Placeholder ObjType 0})
(shapesToElements layout shapes)
let contentContentIds = ((Maybe Integer, Content) -> Maybe Integer)
-> [(Maybe Integer, Content)] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Integer, Content) -> Maybe Integer
forall a b. (a, b) -> a
fst [(Maybe Integer, Content)]
content'
contentElements = (Maybe Integer, Content) -> Content
forall a b. (a, b) -> b
snd ((Maybe Integer, Content) -> Content)
-> [(Maybe Integer, Content)] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Integer, Content)]
content'
footer <- footerElements content
return ( Just ContentShapeIds{..}
, buildSpTree ns spTree (hdrShapeElements <> contentElements <> footer)
)
contentToElement Element
_ [ParaElem]
_ [Shape]
_ = (Maybe ContentShapeIds, Element)
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe ContentShapeIds, Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ContentShapeIds
forall a. Maybe a
Nothing, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" [] ())
data TwoColumnShapeIds = TwoColumnShapeIds
{ TwoColumnShapeIds -> Maybe Integer
twoColumnHeaderId :: Maybe ShapeId
, TwoColumnShapeIds -> [Integer]
twoColumnLeftIds :: [ShapeId]
, TwoColumnShapeIds -> [Integer]
twoColumnRightIds :: [ShapeId]
}
twoColumnToElement ::
PandocMonad m =>
Element ->
[ParaElem] ->
[Shape] ->
[Shape] ->
P m (Maybe TwoColumnShapeIds, Element)
twoColumnToElement :: forall (m :: * -> *).
PandocMonad m =>
Element
-> [ParaElem]
-> [Shape]
-> [Shape]
-> P m (Maybe TwoColumnShapeIds, Element)
twoColumnToElement Element
layout [ParaElem]
hdrShape [Shape]
shapesL [Shape]
shapesR
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld = do
(headerId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
forall (m :: * -> *).
PandocMonad m =>
Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
nonBodyTextToElement Element
layout [Text -> PHType
PHType Text
"title"] [ParaElem]
hdrShape
let hdrShapeElements = [Element -> Content
Elem Element
element | Bool -> Bool
not ([ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrShape)]
twoColumnHeaderId = if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrShape then Maybe Integer
forall a. Maybe a
Nothing else Maybe Integer
headerId
contentL <- local (\WriterEnv
env -> WriterEnv
env {envPlaceholder = Placeholder ObjType 0})
(shapesToElements layout shapesL)
let twoColumnLeftIds = ((Maybe Integer, Content) -> Maybe Integer)
-> [(Maybe Integer, Content)] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Integer, Content) -> Maybe Integer
forall a b. (a, b) -> a
fst [(Maybe Integer, Content)]
contentL
contentElementsL = (Maybe Integer, Content) -> Content
forall a b. (a, b) -> b
snd ((Maybe Integer, Content) -> Content)
-> [(Maybe Integer, Content)] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Integer, Content)]
contentL
contentR <- local (\WriterEnv
env -> WriterEnv
env {envPlaceholder = Placeholder ObjType 1})
(shapesToElements layout shapesR)
let (twoColumnRightIds) = (mapMaybe fst contentR)
contentElementsR = (Maybe Integer, Content) -> Content
forall a b. (a, b) -> b
snd ((Maybe Integer, Content) -> Content)
-> [(Maybe Integer, Content)] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Integer, Content)]
contentR
footer <- footerElements twoColumn
return
$ (Just TwoColumnShapeIds{..}, )
$ buildSpTree ns spTree
$ hdrShapeElements <> contentElementsL <> contentElementsR <> footer
twoColumnToElement Element
_ [ParaElem]
_ [Shape]
_ [Shape]
_ = (Maybe TwoColumnShapeIds, Element)
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe TwoColumnShapeIds, Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TwoColumnShapeIds
forall a. Maybe a
Nothing, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" [] ())
data ComparisonShapeIds = ComparisonShapeIds
{ :: Maybe ShapeId
, ComparisonShapeIds -> [Integer]
comparisonLeftTextIds :: [ShapeId]
, ComparisonShapeIds -> [Integer]
comparisonLeftContentIds :: [ShapeId]
, ComparisonShapeIds -> [Integer]
comparisonRightTextIds :: [ShapeId]
, ComparisonShapeIds -> [Integer]
comparisonRightContentIds :: [ShapeId]
}
comparisonToElement ::
PandocMonad m =>
Element ->
[ParaElem] ->
([Shape], [Shape]) ->
([Shape], [Shape]) ->
P m (Maybe ComparisonShapeIds, Element)
comparisonToElement :: forall (m :: * -> *).
PandocMonad m =>
Element
-> [ParaElem]
-> ([Shape], [Shape])
-> ([Shape], [Shape])
-> P m (Maybe ComparisonShapeIds, Element)
comparisonToElement Element
layout [ParaElem]
hdrShape ([Shape]
shapesL1, [Shape]
shapesL2) ([Shape]
shapesR1, [Shape]
shapesR2)
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld = do
(headerShapeId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
forall (m :: * -> *).
PandocMonad m =>
Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
nonBodyTextToElement Element
layout [Text -> PHType
PHType Text
"title"] [ParaElem]
hdrShape
let hdrShapeElements = [Element -> Content
Elem Element
element | Bool -> Bool
not ([ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrShape)]
comparisonHeaderId = if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrShape then Maybe Integer
forall a. Maybe a
Nothing else Maybe Integer
headerShapeId
contentL1 <- local (\WriterEnv
env -> WriterEnv
env {envPlaceholder = Placeholder (PHType "body") 0})
(shapesToElements layout shapesL1)
let comparisonLeftTextIds = ((Maybe Integer, Content) -> Maybe Integer)
-> [(Maybe Integer, Content)] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Integer, Content) -> Maybe Integer
forall a b. (a, b) -> a
fst [(Maybe Integer, Content)]
contentL1
contentElementsL1 = (Maybe Integer, Content) -> Content
forall a b. (a, b) -> b
snd ((Maybe Integer, Content) -> Content)
-> [(Maybe Integer, Content)] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Integer, Content)]
contentL1
contentL2 <- local (\WriterEnv
env -> WriterEnv
env {envPlaceholder = Placeholder ObjType 0})
(shapesToElements layout shapesL2)
let comparisonLeftContentIds = ((Maybe Integer, Content) -> Maybe Integer)
-> [(Maybe Integer, Content)] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Integer, Content) -> Maybe Integer
forall a b. (a, b) -> a
fst [(Maybe Integer, Content)]
contentL2
contentElementsL2 = (Maybe Integer, Content) -> Content
forall a b. (a, b) -> b
snd ((Maybe Integer, Content) -> Content)
-> [(Maybe Integer, Content)] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Integer, Content)]
contentL2
contentR1 <- local (\WriterEnv
env -> WriterEnv
env {envPlaceholder = Placeholder (PHType "body") 1})
(shapesToElements layout shapesR1)
let comparisonRightTextIds = ((Maybe Integer, Content) -> Maybe Integer)
-> [(Maybe Integer, Content)] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Integer, Content) -> Maybe Integer
forall a b. (a, b) -> a
fst [(Maybe Integer, Content)]
contentR1
contentElementsR1 = (Maybe Integer, Content) -> Content
forall a b. (a, b) -> b
snd ((Maybe Integer, Content) -> Content)
-> [(Maybe Integer, Content)] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Integer, Content)]
contentR1
contentR2 <- local (\WriterEnv
env -> WriterEnv
env {envPlaceholder = Placeholder ObjType 1})
(shapesToElements layout shapesR2)
let comparisonRightContentIds = ((Maybe Integer, Content) -> Maybe Integer)
-> [(Maybe Integer, Content)] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Integer, Content) -> Maybe Integer
forall a b. (a, b) -> a
fst [(Maybe Integer, Content)]
contentR2
contentElementsR2 = (Maybe Integer, Content) -> Content
forall a b. (a, b) -> b
snd ((Maybe Integer, Content) -> Content)
-> [(Maybe Integer, Content)] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Integer, Content)]
contentR2
footer <- footerElements comparison
return
$ (Just ComparisonShapeIds{..}, )
$ buildSpTree ns spTree
$ mconcat [ hdrShapeElements
, contentElementsL1
, contentElementsL2
, contentElementsR1
, contentElementsR2
] <> footer
comparisonToElement Element
_ [ParaElem]
_ ([Shape], [Shape])
_ ([Shape], [Shape])
_= (Maybe ComparisonShapeIds, Element)
-> ReaderT
WriterEnv
(StateT WriterState m)
(Maybe ComparisonShapeIds, Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ComparisonShapeIds
forall a. Maybe a
Nothing, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" [] ())
data ContentWithCaptionShapeIds = ContentWithCaptionShapeIds
{ :: Maybe ShapeId
, ContentWithCaptionShapeIds -> [Integer]
contentWithCaptionCaptionIds :: [ShapeId]
, ContentWithCaptionShapeIds -> [Integer]
contentWithCaptionContentIds :: [ShapeId]
}
contentWithCaptionToElement ::
PandocMonad m =>
Element ->
[ParaElem] ->
[Shape] ->
[Shape] ->
P m (Maybe ContentWithCaptionShapeIds, Element)
contentWithCaptionToElement :: forall (m :: * -> *).
PandocMonad m =>
Element
-> [ParaElem]
-> [Shape]
-> [Shape]
-> P m (Maybe ContentWithCaptionShapeIds, Element)
contentWithCaptionToElement Element
layout [ParaElem]
hdrShape [Shape]
textShapes [Shape]
contentShapes
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld = do
(shapeId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
forall (m :: * -> *).
PandocMonad m =>
Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
nonBodyTextToElement Element
layout [Text -> PHType
PHType Text
"title"] [ParaElem]
hdrShape
let hdrShapeElements = [Element -> Content
Elem Element
element | Bool -> Bool
not ([ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrShape)]
contentWithCaptionHeaderId = if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrShape then Maybe Integer
forall a. Maybe a
Nothing else Maybe Integer
shapeId
text <- local (\WriterEnv
env -> WriterEnv
env {envPlaceholder = Placeholder (PHType "body") 0})
(shapesToElements layout textShapes)
let contentWithCaptionCaptionIds = ((Maybe Integer, Content) -> Maybe Integer)
-> [(Maybe Integer, Content)] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Integer, Content) -> Maybe Integer
forall a b. (a, b) -> a
fst [(Maybe Integer, Content)]
text
textElements = (Maybe Integer, Content) -> Content
forall a b. (a, b) -> b
snd ((Maybe Integer, Content) -> Content)
-> [(Maybe Integer, Content)] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Integer, Content)]
text
content <- local (\WriterEnv
env -> WriterEnv
env {envPlaceholder = Placeholder ObjType 0})
(shapesToElements layout contentShapes)
let contentWithCaptionContentIds = ((Maybe Integer, Content) -> Maybe Integer)
-> [(Maybe Integer, Content)] -> [Integer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Integer, Content) -> Maybe Integer
forall a b. (a, b) -> a
fst [(Maybe Integer, Content)]
content
contentElements = (Maybe Integer, Content) -> Content
forall a b. (a, b) -> b
snd ((Maybe Integer, Content) -> Content)
-> [(Maybe Integer, Content)] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Integer, Content)]
content
footer <- footerElements contentWithCaption
return
$ (Just ContentWithCaptionShapeIds{..}, )
$ buildSpTree ns spTree
$ mconcat [ hdrShapeElements
, textElements
, contentElements
] <> footer
contentWithCaptionToElement Element
_ [ParaElem]
_ [Shape]
_ [Shape]
_ = (Maybe ContentWithCaptionShapeIds, Element)
-> ReaderT
WriterEnv
(StateT WriterState m)
(Maybe ContentWithCaptionShapeIds, Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ContentWithCaptionShapeIds
forall a. Maybe a
Nothing, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" [] ())
blankToElement ::
PandocMonad m =>
Element ->
P m Element
blankToElement :: forall (m :: * -> *). PandocMonad m => Element -> P m Element
blankToElement Element
layout
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld =
[(Text, Text)] -> Element -> [Content] -> Element
buildSpTree [(Text, Text)]
ns Element
spTree ([Content] -> Element)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. SlideLayoutsOf a -> a)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
(forall a. SlideLayoutsOf a -> a) -> P m [Content]
footerElements SlideLayoutsOf a -> a
forall a. SlideLayoutsOf a -> a
blank
blankToElement Element
_ = Element -> ReaderT WriterEnv (StateT WriterState m) Element
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ReaderT WriterEnv (StateT WriterState m) Element)
-> Element -> ReaderT WriterEnv (StateT WriterState m) Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" [] ()
newtype TitleShapeIds = TitleShapeIds
{ :: Maybe ShapeId
}
titleToElement ::
PandocMonad m =>
Element ->
[ParaElem] ->
P m (Maybe TitleShapeIds, Element)
titleToElement :: forall (m :: * -> *).
PandocMonad m =>
Element -> [ParaElem] -> P m (Maybe TitleShapeIds, Element)
titleToElement Element
layout [ParaElem]
titleElems
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld = do
(shapeId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
forall (m :: * -> *).
PandocMonad m =>
Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
nonBodyTextToElement Element
layout [Text -> PHType
PHType Text
"title", Text -> PHType
PHType Text
"ctrTitle"] [ParaElem]
titleElems
let titleShapeElements = [Element -> Content
Elem Element
element | Bool -> Bool
not ([ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
titleElems)]
titleHeaderId = if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
titleElems then Maybe Integer
forall a. Maybe a
Nothing else Maybe Integer
shapeId
footer <- footerElements title
return
$ (Just TitleShapeIds{..}, )
$ buildSpTree ns spTree (titleShapeElements <> footer)
titleToElement Element
_ [ParaElem]
_ = (Maybe TitleShapeIds, Element)
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe TitleShapeIds, Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TitleShapeIds
forall a. Maybe a
Nothing, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" [] ())
data MetadataShapeIds = MetadataShapeIds
{ MetadataShapeIds -> Maybe Integer
metadataTitleId :: Maybe ShapeId
, MetadataShapeIds -> Maybe Integer
metadataSubtitleId :: Maybe ShapeId
, MetadataShapeIds -> Maybe Integer
metadataDateId :: Maybe ShapeId
}
metadataToElement ::
PandocMonad m =>
Element ->
[ParaElem] ->
[ParaElem] ->
[[ParaElem]] ->
[ParaElem] ->
P m (Maybe MetadataShapeIds, Element)
metadataToElement :: forall (m :: * -> *).
PandocMonad m =>
Element
-> [ParaElem]
-> [ParaElem]
-> [[ParaElem]]
-> [ParaElem]
-> P m (Maybe MetadataShapeIds, Element)
metadataToElement Element
layout [ParaElem]
titleElems [ParaElem]
subtitleElems [[ParaElem]]
authorsElems [ParaElem]
dateElems
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
layout
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
layout
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld = do
let combinedAuthorElems :: [ParaElem]
combinedAuthorElems = [ParaElem] -> [[ParaElem]] -> [ParaElem]
forall a. [a] -> [[a]] -> [a]
intercalate [ParaElem
Break] [[ParaElem]]
authorsElems
subtitleAndAuthorElems :: [ParaElem]
subtitleAndAuthorElems = [ParaElem] -> [[ParaElem]] -> [ParaElem]
forall a. [a] -> [[a]] -> [a]
intercalate [ParaElem
Break, ParaElem
Break] [[ParaElem]
subtitleElems, [ParaElem]
combinedAuthorElems]
(titleId, titleElement) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
forall (m :: * -> *).
PandocMonad m =>
Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
nonBodyTextToElement Element
layout [Text -> PHType
PHType Text
"ctrTitle"] [ParaElem]
titleElems
(subtitleId, subtitleElement) <- nonBodyTextToElement layout [PHType "subTitle"] subtitleAndAuthorElems
(dateId, dateElement) <- nonBodyTextToElement layout [PHType "dt"] dateElems
let titleShapeElements = [Element
titleElement | Bool -> Bool
not ([ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
titleElems)]
metadataTitleId = if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
titleElems then Maybe Integer
forall a. Maybe a
Nothing else Maybe Integer
titleId
subtitleShapeElements = [Element
subtitleElement | Bool -> Bool
not ([ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
subtitleAndAuthorElems)]
metadataSubtitleId = if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
subtitleAndAuthorElems then Maybe Integer
forall a. Maybe a
Nothing else Maybe Integer
subtitleId
footerInfo <- gets stFooterInfo
footer <- (if maybe False fiShowOnFirstSlide footerInfo
then id
else const []) <$> footerElements metadata
let dateShapeElements = [Element
dateElement
| Bool -> Bool
not ([ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
dateElems
Bool -> Bool -> Bool
|| Maybe Element -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FooterInfo
footerInfo Maybe FooterInfo -> (FooterInfo -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SlideLayoutsOf (Maybe Element) -> Maybe Element
forall a. SlideLayoutsOf a -> a
metadata (SlideLayoutsOf (Maybe Element) -> Maybe Element)
-> (FooterInfo -> SlideLayoutsOf (Maybe Element))
-> FooterInfo
-> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FooterInfo -> SlideLayoutsOf (Maybe Element)
fiDate))
]
metadataDateId = if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
dateElems then Maybe Integer
forall a. Maybe a
Nothing else Maybe Integer
dateId
return
$ (Just MetadataShapeIds{..}, )
$ buildSpTree ns spTree
$ map Elem (titleShapeElements <> subtitleShapeElements <> dateShapeElements)
<> footer
metadataToElement Element
_ [ParaElem]
_ [ParaElem]
_ [[ParaElem]]
_ [ParaElem]
_ = (Maybe MetadataShapeIds, Element)
-> ReaderT
WriterEnv (StateT WriterState m) (Maybe MetadataShapeIds, Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetadataShapeIds
forall a. Maybe a
Nothing, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" [] ())
slideToElement :: PandocMonad m => Slide -> P m Element
slideToElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m Element
slideToElement (Slide SlideId
_ l :: Layout
l@(ContentSlide [ParaElem]
hdrElems [Shape]
shapes) SpeakerNotes
_ Maybe FilePath
backgroundImage) = do
layout <- Layout -> P m Element
forall (m :: * -> *). PandocMonad m => Layout -> P m Element
getLayout Layout
l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree)
<- local (\WriterEnv
env -> if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrElems
then WriterEnv
env
else WriterEnv
env{envSlideHasHeader=True})
(contentToElement layout hdrElems shapes)
let animations = case Maybe ContentShapeIds
shapeIds of
Maybe ContentShapeIds
Nothing -> []
Just ContentShapeIds{[Integer]
Maybe Integer
contentHeaderId :: ContentShapeIds -> Maybe Integer
contentContentIds :: ContentShapeIds -> [Integer]
contentHeaderId :: Maybe Integer
contentContentIds :: [Integer]
..} ->
[(Integer, Shape)] -> [Element]
slideToIncrementalAnimations ([Integer] -> [Shape] -> [(Integer, Shape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
contentContentIds [Shape]
shapes)
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide SlideId
_ l :: Layout
l@(TwoColumnSlide [ParaElem]
hdrElems [Shape]
shapesL [Shape]
shapesR) SpeakerNotes
_ Maybe FilePath
backgroundImage) = do
layout <- Layout -> P m Element
forall (m :: * -> *). PandocMonad m => Layout -> P m Element
getLayout Layout
l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) <- local (\WriterEnv
env -> if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrElems
then WriterEnv
env
else WriterEnv
env{envSlideHasHeader=True}) $
twoColumnToElement layout hdrElems shapesL shapesR
let animations = case Maybe TwoColumnShapeIds
shapeIds of
Maybe TwoColumnShapeIds
Nothing -> []
Just TwoColumnShapeIds{[Integer]
Maybe Integer
twoColumnHeaderId :: TwoColumnShapeIds -> Maybe Integer
twoColumnLeftIds :: TwoColumnShapeIds -> [Integer]
twoColumnRightIds :: TwoColumnShapeIds -> [Integer]
twoColumnHeaderId :: Maybe Integer
twoColumnLeftIds :: [Integer]
twoColumnRightIds :: [Integer]
..} ->
[(Integer, Shape)] -> [Element]
slideToIncrementalAnimations ([Integer] -> [Shape] -> [(Integer, Shape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
twoColumnLeftIds [Shape]
shapesL
[(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
forall a. Semigroup a => a -> a -> a
<> [Integer] -> [Shape] -> [(Integer, Shape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
twoColumnRightIds [Shape]
shapesR)
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide SlideId
_ l :: Layout
l@(ComparisonSlide [ParaElem]
hdrElems ([Shape], [Shape])
shapesL ([Shape], [Shape])
shapesR) SpeakerNotes
_ Maybe FilePath
backgroundImage) = do
layout <- Layout -> P m Element
forall (m :: * -> *). PandocMonad m => Layout -> P m Element
getLayout Layout
l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) <- local (\WriterEnv
env -> if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
hdrElems
then WriterEnv
env
else WriterEnv
env{envSlideHasHeader=True}) $
comparisonToElement layout hdrElems shapesL shapesR
let animations = case Maybe ComparisonShapeIds
shapeIds of
Maybe ComparisonShapeIds
Nothing -> []
Just ComparisonShapeIds{[Integer]
Maybe Integer
comparisonHeaderId :: ComparisonShapeIds -> Maybe Integer
comparisonLeftTextIds :: ComparisonShapeIds -> [Integer]
comparisonLeftContentIds :: ComparisonShapeIds -> [Integer]
comparisonRightTextIds :: ComparisonShapeIds -> [Integer]
comparisonRightContentIds :: ComparisonShapeIds -> [Integer]
comparisonHeaderId :: Maybe Integer
comparisonLeftTextIds :: [Integer]
comparisonLeftContentIds :: [Integer]
comparisonRightTextIds :: [Integer]
comparisonRightContentIds :: [Integer]
..} ->
[(Integer, Shape)] -> [Element]
slideToIncrementalAnimations
([Integer] -> [Shape] -> [(Integer, Shape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
comparisonLeftTextIds (([Shape], [Shape]) -> [Shape]
forall a b. (a, b) -> a
fst ([Shape], [Shape])
shapesL)
[(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
forall a. Semigroup a => a -> a -> a
<> [Integer] -> [Shape] -> [(Integer, Shape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
comparisonLeftContentIds (([Shape], [Shape]) -> [Shape]
forall a b. (a, b) -> b
snd ([Shape], [Shape])
shapesL)
[(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
forall a. Semigroup a => a -> a -> a
<> [Integer] -> [Shape] -> [(Integer, Shape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
comparisonRightTextIds (([Shape], [Shape]) -> [Shape]
forall a b. (a, b) -> a
fst ([Shape], [Shape])
shapesR)
[(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
forall a. Semigroup a => a -> a -> a
<> [Integer] -> [Shape] -> [(Integer, Shape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
comparisonRightContentIds (([Shape], [Shape]) -> [Shape]
forall a b. (a, b) -> b
snd ([Shape], [Shape])
shapesR))
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide SlideId
_ l :: Layout
l@(TitleSlide [ParaElem]
hdrElems) SpeakerNotes
_ Maybe FilePath
backgroundImage) = do
layout <- Layout -> P m Element
forall (m :: * -> *). PandocMonad m => Layout -> P m Element
getLayout Layout
l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(_, spTree) <- titleToElement layout hdrElems
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
slideToElement (Slide
SlideId
_
l :: Layout
l@(MetadataSlide [ParaElem]
titleElems [ParaElem]
subtitleElems [[ParaElem]]
authorElems [ParaElem]
dateElems)
SpeakerNotes
_
Maybe FilePath
backgroundImage) = do
layout <- Layout -> P m Element
forall (m :: * -> *). PandocMonad m => Layout -> P m Element
getLayout Layout
l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(_, spTree) <- metadataToElement layout titleElems subtitleElems authorElems dateElems
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
slideToElement (Slide
SlideId
_
l :: Layout
l@(ContentWithCaptionSlide [ParaElem]
hdrElems [Shape]
captionShapes [Shape]
contentShapes)
SpeakerNotes
_
Maybe FilePath
backgroundImage) = do
layout <- Layout -> P m Element
forall (m :: * -> *). PandocMonad m => Layout -> P m Element
getLayout Layout
l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) <- contentWithCaptionToElement layout hdrElems captionShapes contentShapes
let animations = case Maybe ContentWithCaptionShapeIds
shapeIds of
Maybe ContentWithCaptionShapeIds
Nothing -> []
Just ContentWithCaptionShapeIds{[Integer]
Maybe Integer
contentWithCaptionHeaderId :: ContentWithCaptionShapeIds -> Maybe Integer
contentWithCaptionCaptionIds :: ContentWithCaptionShapeIds -> [Integer]
contentWithCaptionContentIds :: ContentWithCaptionShapeIds -> [Integer]
contentWithCaptionHeaderId :: Maybe Integer
contentWithCaptionCaptionIds :: [Integer]
contentWithCaptionContentIds :: [Integer]
..} ->
[(Integer, Shape)] -> [Element]
slideToIncrementalAnimations
([Integer] -> [Shape] -> [(Integer, Shape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
contentWithCaptionCaptionIds [Shape]
captionShapes
[(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
forall a. Semigroup a => a -> a -> a
<> [Integer] -> [Shape] -> [(Integer, Shape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
contentWithCaptionContentIds [Shape]
contentShapes)
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide SlideId
_ Layout
BlankSlide SpeakerNotes
_ Maybe FilePath
backgroundImage) = do
layout <- Layout -> P m Element
forall (m :: * -> *). PandocMonad m => Layout -> P m Element
getLayout Layout
BlankSlide
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
spTree <- blankToElement layout
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
backgroundImageToElement :: PandocMonad m => FilePath -> P m Element
backgroundImageToElement :: forall (m :: * -> *). PandocMonad m => FilePath -> P m Element
backgroundImageToElement FilePath
path = do
MediaInfo{mInfoLocalId, mInfoFilePath} <- FilePath -> [ParaElem] -> P m MediaInfo
forall (m :: * -> *).
PandocMonad m =>
FilePath -> [ParaElem] -> P m MediaInfo
registerMedia FilePath
path []
(imgBytes, _) <- P.fetchItem (T.pack mInfoFilePath)
opts <- asks envOpts
let imageDimensions = (Text -> Maybe (Integer, Integer))
-> (ImageSize -> Maybe (Integer, Integer))
-> Either Text ImageSize
-> Maybe (Integer, Integer)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Integer, Integer) -> Text -> Maybe (Integer, Integer)
forall a b. a -> b -> a
const Maybe (Integer, Integer)
forall a. Maybe a
Nothing)
((Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just ((Integer, Integer) -> Maybe (Integer, Integer))
-> (ImageSize -> (Integer, Integer))
-> ImageSize
-> Maybe (Integer, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImageSize -> (Integer, Integer)
sizeInPixels)
(WriterOptions -> StrictByteString -> Either Text ImageSize
imageSize WriterOptions
opts StrictByteString
imgBytes)
pageSize <- asks envPresentationSize
let fillRectAttributes = [(Text, Text)]
-> ((Integer, Integer) -> [(Text, Text)])
-> Maybe (Integer, Integer)
-> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Integer, Integer) -> (Integer, Integer) -> [(Text, Text)]
offsetAttributes (Integer, Integer)
pageSize) Maybe (Integer, Integer)
imageDimensions
let rId = Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
mInfoLocalId)
return
$ mknode "p:bg" []
$ mknode "p:bgPr" []
[ mknode "a:blipFill" [("dpi", "0"), ("rotWithShape", "1")]
[ mknode "a:blip" [("r:embed", rId)]
$ mknode "a:lum" [] ()
, mknode "a:srcRect" [] ()
, mknode "a:stretch" []
$ mknode "a:fillRect" fillRectAttributes ()
]
, mknode "a:effectsLst" [] ()
]
where
offsetAttributes :: (Integer, Integer) -> (Integer, Integer) -> [(Text, Text)]
offsetAttributes :: (Integer, Integer) -> (Integer, Integer) -> [(Text, Text)]
offsetAttributes (Integer
pageWidth, Integer
pageHeight) (Integer
pictureWidth, Integer
pictureHeight) = let
widthRatio :: Rational
widthRatio = Integer
pictureWidth Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
pageWidth
heightRatio :: Rational
heightRatio = Integer
pictureHeight Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
pageHeight
getOffset :: Ratio Integer -> Text
getOffset :: Rational -> Text
getOffset Rational
proportion = let
percentageOffset :: Rational
percentageOffset = (Rational
proportion Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
1) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (-Integer
100 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2)
integerOffset :: Integer
integerOffset = Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Rational
percentageOffset Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 :: Integer
in FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
integerOffset)
in case Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rational
widthRatio Rational
heightRatio of
Ordering
EQ -> []
Ordering
LT -> let
offset :: Text
offset = Rational -> Text
getOffset ((Integer
pictureHeight Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
pageHeight) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
widthRatio)
in [ (Text
"t", Text
offset)
, (Text
"b", Text
offset)
]
Ordering
GT -> let
offset :: Text
offset = Rational -> Text
getOffset ((Integer
pictureWidth Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
pageWidth) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
heightRatio)
in [ (Text
"l", Text
offset)
, (Text
"r", Text
offset)
]
slideToIncrementalAnimations ::
[(ShapeId, Shape)] ->
[Element]
slideToIncrementalAnimations :: [(Integer, Shape)] -> [Element]
slideToIncrementalAnimations [(Integer, Shape)]
shapes = let
incrementals :: [(ShapeId, [Bool])]
incrementals :: [(Integer, [Bool])]
incrementals = do
(shapeId, TextBox ps) <- [(Integer, Shape)]
shapes
pure . (shapeId,) $ do
Paragraph ParaProps{pPropIncremental} _ <- ps
pure pPropIncremental
toIndices :: [Bool] -> Maybe (NonEmpty (Integer, Integer))
toIndices :: [Bool] -> Maybe (NonEmpty (Integer, Integer))
toIndices [Bool]
bs = do
let indexed :: [(Integer, Bool)]
indexed = [Integer] -> [Bool] -> [(Integer, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [Bool]
bs
ts <- [(Integer, Bool)] -> Maybe (NonEmpty (Integer, Bool))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (((Integer, Bool) -> Bool) -> [(Integer, Bool)] -> [(Integer, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer, Bool) -> Bool
forall a b. (a, b) -> b
snd [(Integer, Bool)]
indexed)
pure (fmap (\(Integer
n, Bool
_) -> (Integer
n, Integer
n)) ts)
indices :: [(ShapeId, NonEmpty (Integer, Integer))]
indices :: [(Integer, NonEmpty (Integer, Integer))]
indices = do
(shapeId, bs) <- [(Integer, [Bool])]
incrementals
toList ((,) shapeId <$> toIndices bs)
in Maybe Element -> [Element]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Integer, NonEmpty (Integer, Integer)) -> Element
incrementalAnimation (NonEmpty (Integer, NonEmpty (Integer, Integer)) -> Element)
-> Maybe (NonEmpty (Integer, NonEmpty (Integer, Integer)))
-> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Integer, NonEmpty (Integer, Integer))]
-> Maybe (NonEmpty (Integer, NonEmpty (Integer, Integer)))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(Integer, NonEmpty (Integer, Integer))]
indices)
getNotesMaster :: PandocMonad m => P m Element
getNotesMaster :: forall (m :: * -> *). PandocMonad m => P m Element
getNotesMaster = do
refArchive <- (WriterEnv -> Archive)
-> ReaderT WriterEnv (StateT WriterState m) Archive
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
distArchive <- asks envDistArchive
parseXml refArchive distArchive "ppt/notesMasters/notesMaster1.xml"
getSlideNumberFieldId :: PandocMonad m => Element -> P m T.Text
getSlideNumberFieldId :: forall (m :: * -> *). PandocMonad m => Element -> P m Text
getSlideNumberFieldId Element
notesMaster
| [(Text, Text)]
ns <- Element -> [(Text, Text)]
elemToNameSpaces Element
notesMaster
, Just Element
cSld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"cSld") Element
notesMaster
, Just Element
spTree <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"spTree") Element
cSld
, Just Element
sp <- [(Text, Text)] -> Element -> PHType -> Maybe Element
getShapeByPlaceHolderType [(Text, Text)]
ns Element
spTree (Text -> PHType
PHType Text
"sldNum")
, Just Element
txBody <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"p" Text
"txBody") Element
sp
, Just Element
p <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"a" Text
"p") Element
txBody
, Just Element
fld <- QName -> Element -> Maybe Element
findChild ([(Text, Text)] -> Text -> Text -> QName
elemName [(Text, Text)]
ns Text
"a" Text
"fld") Element
p
, Just Text
fldId <- QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"id" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
fld =
Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
fldId
| Bool
otherwise = PandocError -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ReaderT WriterEnv (StateT WriterState m) Text)
-> PandocError -> ReaderT WriterEnv (StateT WriterState m) Text
forall a b. (a -> b) -> a -> b
$
Text -> PandocError
PandocSomeError
Text
"No field id for slide numbers in notesMaster.xml"
speakerNotesSlideImage :: Element
speakerNotesSlideImage :: Element
speakerNotesSlideImage =
Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" []
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:nvSpPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cNvPr" [ (Text
"id", Text
"2")
, (Text
"name", Text
"Slide Image Placeholder 1")
] ()
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cNvSpPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:spLocks" [ (Text
"noGrp", Text
"1")
, (Text
"noRot", Text
"1")
, (Text
"noChangeAspect", Text
"1")
] ()
]
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:nvPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:ph" [(Text
"type", Text
"sldImg")] ()]
]
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:spPr" [] ()
]
removeParaLinks :: Paragraph -> Paragraph
removeParaLinks :: Paragraph -> Paragraph
removeParaLinks Paragraph
paragraph = Paragraph
paragraph{paraElems = map f (paraElems paragraph)}
where f :: ParaElem -> ParaElem
f (Run RunProps
rProps Text
s) = RunProps -> Text -> ParaElem
Run RunProps
rProps{rLink=Nothing} Text
s
f ParaElem
pe = ParaElem
pe
spaceParas :: [Paragraph] -> [Paragraph]
spaceParas :: [Paragraph] -> [Paragraph]
spaceParas = Paragraph -> [Paragraph] -> [Paragraph]
forall a. a -> [a] -> [a]
intersperse (ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
forall a. Default a => a
def [])
speakerNotesBody :: PandocMonad m => [Paragraph] -> P m Element
speakerNotesBody :: forall (m :: * -> *). PandocMonad m => [Paragraph] -> P m Element
speakerNotesBody [Paragraph]
paras = do
elements <- (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) [Element]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envInSpeakerNotes = True}) (ReaderT WriterEnv (StateT WriterState m) [Element]
-> ReaderT WriterEnv (StateT WriterState m) [Element])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall a b. (a -> b) -> a -> b
$
(Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element)
-> [Paragraph]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element
forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
paragraphToElement ([Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element])
-> [Paragraph]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall a b. (a -> b) -> a -> b
$ [Paragraph] -> [Paragraph]
spaceParas ([Paragraph] -> [Paragraph]) -> [Paragraph] -> [Paragraph]
forall a b. (a -> b) -> a -> b
$ (Paragraph -> Paragraph) -> [Paragraph] -> [Paragraph]
forall a b. (a -> b) -> [a] -> [b]
map Paragraph -> Paragraph
removeParaLinks [Paragraph]
paras
let txBody = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:txBody" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:bodyPr" [] (), Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<> [Element]
elements
return $
surroundWithMathAlternate $
mknode "p:sp" []
[ mknode "p:nvSpPr" []
[ mknode "p:cNvPr" [ ("id", "3")
, ("name", "Notes Placeholder 2")
] ()
, mknode "p:cNvSpPr" []
[ mknode "a:spLocks" [("noGrp", "1")] ()]
, mknode "p:nvPr" []
[ mknode "p:ph" [("type", "body"), ("idx", "1")] ()]
]
, mknode "p:spPr" [] ()
, txBody
]
speakerNotesSlideNumber :: Int -> T.Text -> Element
speakerNotesSlideNumber :: Int -> Text -> Element
speakerNotesSlideNumber Int
pgNum Text
fieldId =
Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sp" []
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:nvSpPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cNvPr" [ (Text
"id", Text
"4")
, (Text
"name", Text
"Slide Number Placeholder 3")
] ()
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cNvSpPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:spLocks" [(Text
"noGrp", Text
"1")] ()]
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:nvPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:ph" [ (Text
"type", Text
"sldNum")
, (Text
"sz", Text
"quarter")
, (Text
"idx", Text
"10")
] ()
]
]
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:spPr" [] ()
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:txBody" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:bodyPr" [] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:lstStyle" [] ()
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:p" []
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:fld" [ (Text
"id", Text
fieldId)
, (Text
"type", Text
"slidenum")
]
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:rPr" [(Text
"lang", Text
"en-US")] ()
, Text -> [(Text, Text)] -> Text -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:t" [] (Int -> Text
forall a. Show a => a -> Text
tshow Int
pgNum)
]
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:endParaRPr" [(Text
"lang", Text
"en-US")] ()
]
]
]
slideToSpeakerNotesElement :: PandocMonad m => Slide -> P m (Maybe Element)
slideToSpeakerNotesElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
slideToSpeakerNotesElement (Slide SlideId
_ Layout
_ (SpeakerNotes []) Maybe FilePath
_) = Maybe Element
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
forall a. Maybe a
Nothing
slideToSpeakerNotesElement slide :: Slide
slide@(Slide SlideId
_ Layout
_ (SpeakerNotes [Paragraph]
paras) Maybe FilePath
_) = do
master <- P m Element
forall (m :: * -> *). PandocMonad m => P m Element
getNotesMaster
fieldId <- getSlideNumberFieldId master
num <- slideNum slide
let imgShape = Element
speakerNotesSlideImage
sldNumShape = Int -> Text -> Element
speakerNotesSlideNumber Int
num Text
fieldId
bodyShape <- speakerNotesBody paras
return $ Just $
mknode "p:notes"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main")
, ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships")
, ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] [ mknode "p:cSld" []
[ mknode "p:spTree" []
[ mknode "p:nvGrpSpPr" []
[ mknode "p:cNvPr" [("id", "1"), ("name", "")] ()
, mknode "p:cNvGrpSpPr" [] ()
, mknode "p:nvPr" [] ()
]
, mknode "p:grpSpPr" []
[ mknode "a:xfrm" []
[ mknode "a:off" [("x", "0"), ("y", "0")] ()
, mknode "a:ext" [("cx", "0"), ("cy", "0")] ()
, mknode "a:chOff" [("x", "0"), ("y", "0")] ()
, mknode "a:chExt" [("cx", "0"), ("cy", "0")] ()
]
]
, imgShape
, bodyShape
, sldNumShape
]
]
]
getSlideIdNum :: PandocMonad m => SlideId -> P m Int
getSlideIdNum :: forall (m :: * -> *). PandocMonad m => SlideId -> P m Int
getSlideIdNum SlideId
sldId = do
slideIdMap <- (WriterEnv -> Map SlideId Int)
-> ReaderT WriterEnv (StateT WriterState m) (Map SlideId Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Map SlideId Int
envSlideIdMap
case M.lookup sldId slideIdMap of
Just Int
n -> Int -> ReaderT WriterEnv (StateT WriterState m) Int
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
Maybe Int
Nothing -> PandocError -> ReaderT WriterEnv (StateT WriterState m) Int
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> ReaderT WriterEnv (StateT WriterState m) Int)
-> PandocError -> ReaderT WriterEnv (StateT WriterState m) Int
forall a b. (a -> b) -> a -> b
$
Text -> PandocError
PandocShouldNeverHappenError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$
Text
"Slide Id " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlideId -> Text
forall a. Show a => a -> Text
tshow SlideId
sldId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found."
slideNum :: PandocMonad m => Slide -> P m Int
slideNum :: forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide = SlideId -> P m Int
forall (m :: * -> *). PandocMonad m => SlideId -> P m Int
getSlideIdNum (SlideId -> P m Int) -> SlideId -> P m Int
forall a b. (a -> b) -> a -> b
$ Slide -> SlideId
slideId Slide
slide
idNumToFilePath :: Int -> FilePath
idNumToFilePath :: Int -> FilePath
idNumToFilePath Int
idNum = FilePath
"slide" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
idNum FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
slideToFilePath :: PandocMonad m => Slide -> P m FilePath
slideToFilePath :: forall (m :: * -> *). PandocMonad m => Slide -> P m FilePath
slideToFilePath Slide
slide = do
idNum <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
return $ "slide" <> show idNum <> ".xml"
slideToRelId ::
PandocMonad m =>
MinimumRId ->
Slide ->
P m T.Text
slideToRelId :: forall (m :: * -> *). PandocMonad m => Int -> Slide -> P m Text
slideToRelId Int
minSlideRId Slide
slide = do
n <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
return $ "rId" <> tshow (n + minSlideRId - 1)
data Relationship = Relationship { Relationship -> Int
relId :: Int
, Relationship -> Text
relType :: MimeType
, Relationship -> FilePath
relTarget :: FilePath
} deriving (Int -> Relationship -> FilePath -> FilePath
[Relationship] -> FilePath -> FilePath
Relationship -> FilePath
(Int -> Relationship -> FilePath -> FilePath)
-> (Relationship -> FilePath)
-> ([Relationship] -> FilePath -> FilePath)
-> Show Relationship
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Relationship -> FilePath -> FilePath
showsPrec :: Int -> Relationship -> FilePath -> FilePath
$cshow :: Relationship -> FilePath
show :: Relationship -> FilePath
$cshowList :: [Relationship] -> FilePath -> FilePath
showList :: [Relationship] -> FilePath -> FilePath
Show, Relationship -> Relationship -> Bool
(Relationship -> Relationship -> Bool)
-> (Relationship -> Relationship -> Bool) -> Eq Relationship
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Relationship -> Relationship -> Bool
== :: Relationship -> Relationship -> Bool
$c/= :: Relationship -> Relationship -> Bool
/= :: Relationship -> Relationship -> Bool
Eq)
elementToRel :: Element -> Maybe Relationship
elementToRel :: Element -> Maybe Relationship
elementToRel Element
element
| Element -> QName
elName Element
element QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Relationship" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://schemas.openxmlformats.org/package/2006/relationships") Maybe Text
forall a. Maybe a
Nothing =
do rId <- QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Id" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
element
numStr <- T.stripPrefix "rId" rId
num <- fromIntegral <$> readTextAsInteger numStr
type' <- findAttr (QName "Type" Nothing Nothing) element
target <- findAttr (QName "Target" Nothing Nothing) element
return $ Relationship num type' (T.unpack target)
| Bool
otherwise = Maybe Relationship
forall a. Maybe a
Nothing
slideToPresRel :: PandocMonad m => Int -> Slide -> P m Relationship
slideToPresRel :: forall (m :: * -> *).
PandocMonad m =>
Int -> Slide -> P m Relationship
slideToPresRel Int
minimumSlideRId Slide
slide = do
idNum <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
let rId = Int
idNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minimumSlideRId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
fp = FilePath
"slides/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
idNumToFilePath Int
idNum
return $ Relationship { relId = rId
, relType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide"
, relTarget = fp
}
getPresentationRels :: PandocMonad m => P m [Relationship]
getPresentationRels :: forall (m :: * -> *). PandocMonad m => P m [Relationship]
getPresentationRels = do
refArchive <- (WriterEnv -> Archive)
-> ReaderT WriterEnv (StateT WriterState m) Archive
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
distArchive <- asks envDistArchive
relsElem <- parseXml refArchive distArchive "ppt/_rels/presentation.xml.rels"
let globalNS = Text
"http://schemas.openxmlformats.org/package/2006/relationships"
let relElems = QName -> Element -> [Element]
findChildren (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Relationship" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
globalNS) Maybe Text
forall a. Maybe a
Nothing) Element
relsElem
return $ mapMaybe elementToRel relElems
type PresentationRIdUpdateData = (ReferenceMinRIdAfterSlides, NewRIdBounds)
type NewRIdBounds = (MinimumRId, MaximumRId)
type ReferenceMinRIdAfterSlides = Int
type MinimumRId = Int
type MaximumRId = Int
updatePresentationRId :: PresentationRIdUpdateData -> Int -> Int
updatePresentationRId :: PresentationRIdUpdateData -> Int -> Int
updatePresentationRId (Int
minOverlappingRId, (Int
minNewId, Int
maxNewId)) Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minNewId = Int
n
| Bool
otherwise = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minOverlappingRId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxNewId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
presentationToRels ::
PandocMonad m =>
Presentation ->
P m (PresentationRIdUpdateData, [Relationship])
presentationToRels :: forall (m :: * -> *).
PandocMonad m =>
Presentation -> P m (PresentationRIdUpdateData, [Relationship])
presentationToRels pres :: Presentation
pres@(Presentation DocProps
_ [Slide]
slides) = do
rels <- P m [Relationship]
forall (m :: * -> *). PandocMonad m => P m [Relationship]
getPresentationRels
let masterRels = (Relationship -> Bool) -> [Relationship] -> [Relationship]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isSuffixOf Text
"slideMaster" (Text -> Bool) -> (Relationship -> Text) -> Relationship -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationship -> Text
relType) [Relationship]
rels
slideStartId = Int
-> (NonEmpty Relationship -> Int)
-> Maybe (NonEmpty Relationship)
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int)
-> (NonEmpty Relationship -> Int) -> NonEmpty Relationship -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NonEmpty Int -> Int)
-> (NonEmpty Relationship -> NonEmpty Int)
-> NonEmpty Relationship
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relationship -> Int) -> NonEmpty Relationship -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Relationship -> Int
relId) ([Relationship] -> Maybe (NonEmpty Relationship)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Relationship]
masterRels)
relsWeKeep = (Relationship -> Bool) -> [Relationship] -> [Relationship]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\Relationship
r -> Relationship -> Text
relType Relationship
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide" Bool -> Bool -> Bool
&&
Relationship -> Text
relType Relationship
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
[Relationship]
rels
minOverlappingRel = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
([Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ((Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int
slideStartId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=)
(Relationship -> Int
relId (Relationship -> Int) -> [Relationship] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Relationship]
relsWeKeep)))
mySlideRels <- mapM (slideToPresRel slideStartId) slides
let notesMasterRels =
[Relationship { relId :: Int
relId = Int
slideStartId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Relationship] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Relationship]
mySlideRels
, relType :: Text
relType = Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster"
, relTarget :: FilePath
relTarget = FilePath
"notesMasters/notesMaster1.xml"
} | Presentation -> Bool
presHasSpeakerNotes Presentation
pres]
insertedRels = [Relationship]
mySlideRels [Relationship] -> [Relationship] -> [Relationship]
forall a. Semigroup a => a -> a -> a
<> [Relationship]
notesMasterRels
newRIdBounds = (Int
slideStartId, Int
slideStartId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Relationship] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Relationship]
insertedRels Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
updateRId = PresentationRIdUpdateData -> Int -> Int
updatePresentationRId (Int
minOverlappingRel, (Int, Int)
newRIdBounds)
relsWeKeep' = (Relationship -> Relationship) -> [Relationship] -> [Relationship]
forall a b. (a -> b) -> [a] -> [b]
map (\Relationship
r -> Relationship
r{relId = updateRId $ relId r}) [Relationship]
relsWeKeep
return ((minOverlappingRel, newRIdBounds), insertedRels <> relsWeKeep')
topLevelRels :: [Relationship]
topLevelRels :: [Relationship]
topLevelRels =
[ Relationship { relId :: Int
relId = Int
1
, relType :: Text
relType = Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument"
, relTarget :: FilePath
relTarget = FilePath
"ppt/presentation.xml"
}
, Relationship { relId :: Int
relId = Int
2
, relType :: Text
relType = Text
"http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties"
, relTarget :: FilePath
relTarget = FilePath
"docProps/core.xml"
}
, Relationship { relId :: Int
relId = Int
3
, relType :: Text
relType = Text
"http://schemas.openxmlformats.org/package/2006/relationships/metadata/extended-properties"
, relTarget :: FilePath
relTarget = FilePath
"docProps/app.xml"
}
, Relationship { relId :: Int
relId = Int
4
, relType :: Text
relType = Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties"
, relTarget :: FilePath
relTarget = FilePath
"docProps/custom.xml"
}
]
topLevelRelsEntry :: PandocMonad m => P m Entry
topLevelRelsEntry :: forall (m :: * -> *). PandocMonad m => P m Entry
topLevelRelsEntry = FilePath -> Element -> P m Entry
forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
"_rels/.rels" (Element -> P m Entry) -> Element -> P m Entry
forall a b. (a -> b) -> a -> b
$ [Relationship] -> Element
relsToElement [Relationship]
topLevelRels
relToElement :: Relationship -> Element
relToElement :: Relationship -> Element
relToElement Relationship
rel = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"Relationship" [ (Text
"Id", Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Relationship -> Int
relId Relationship
rel))
, (Text
"Type", Relationship -> Text
relType Relationship
rel)
, (Text
"Target", FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Relationship -> FilePath
relTarget Relationship
rel) ] ()
relsToElement :: [Relationship] -> Element
relsToElement :: [Relationship] -> Element
relsToElement [Relationship]
rels = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"Relationships"
[(Text
"xmlns", Text
"http://schemas.openxmlformats.org/package/2006/relationships")]
((Relationship -> Element) -> [Relationship] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Relationship -> Element
relToElement [Relationship]
rels)
presentationToRelsEntry ::
PandocMonad m =>
Presentation ->
P m (PresentationRIdUpdateData, Entry)
presentationToRelsEntry :: forall (m :: * -> *).
PandocMonad m =>
Presentation -> P m (PresentationRIdUpdateData, Entry)
presentationToRelsEntry Presentation
pres = do
(presentationRIdUpdateData, rels) <- Presentation -> P m (PresentationRIdUpdateData, [Relationship])
forall (m :: * -> *).
PandocMonad m =>
Presentation -> P m (PresentationRIdUpdateData, [Relationship])
presentationToRels Presentation
pres
element <- elemToEntry "ppt/_rels/presentation.xml.rels" $ relsToElement rels
pure (presentationRIdUpdateData, element)
elemToEntry :: PandocMonad m => FilePath -> Element -> P m Entry
elemToEntry :: forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
fp Element
element = do
epochtime <- POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> Integer)
-> ReaderT WriterEnv (StateT WriterState m) UTCTime
-> ReaderT WriterEnv (StateT WriterState m) Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterEnv -> UTCTime)
-> ReaderT WriterEnv (StateT WriterState m) UTCTime
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> UTCTime
envUTCTime
return $ toEntry fp epochtime $ renderXml element
slideToEntry :: PandocMonad m => Slide -> P m Entry
slideToEntry :: forall (m :: * -> *). PandocMonad m => Slide -> P m Entry
slideToEntry Slide
slide = do
idNum <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
local (\WriterEnv
env -> WriterEnv
env{envCurSlideId = idNum}) $ do
element <- slideToElement slide
elemToEntry ("ppt/slides/" <> idNumToFilePath idNum) element
slideToSpeakerNotesEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
slideToSpeakerNotesEntry :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Entry)
slideToSpeakerNotesEntry Slide
slide = do
idNum <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
local (\WriterEnv
env -> WriterEnv
env{envCurSlideId = idNum}) $ do
mbElement <- slideToSpeakerNotesElement slide
mbNotesIdNum <- do mp <- asks envSpeakerNotesIdMap
return $ M.lookup idNum mp
case mbElement of
Just Element
element | Just Int
notesIdNum <- Maybe Int
mbNotesIdNum ->
Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry)
-> ReaderT WriterEnv (StateT WriterState m) Entry
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
FilePath
-> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry
(FilePath
"ppt/notesSlides/notesSlide" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
notesIdNum FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
FilePath
".xml")
Element
element
Maybe Element
_ -> Maybe Entry
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Entry
forall a. Maybe a
Nothing
slideToSpeakerNotesRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
slideToSpeakerNotesRelElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
slideToSpeakerNotesRelElement (Slide SlideId
_ Layout
_ (SpeakerNotes []) Maybe FilePath
_) = Maybe Element
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Element)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
forall a. Maybe a
Nothing
slideToSpeakerNotesRelElement slide :: Slide
slide@Slide{} = do
idNum <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
return $ Just $
mknode "Relationships"
[("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
[ mknode "Relationship" [ ("Id", "rId2")
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
, ("Target", "../slides/slide" <> tshow idNum <> ".xml")
] ()
, mknode "Relationship" [ ("Id", "rId1")
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
, ("Target", "../notesMasters/notesMaster1.xml")
] ()
]
slideToSpeakerNotesRelEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
slideToSpeakerNotesRelEntry :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Entry)
slideToSpeakerNotesRelEntry Slide
slide = do
idNum <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
mbElement <- slideToSpeakerNotesRelElement slide
mp <- asks envSpeakerNotesIdMap
let mbNotesIdNum = Int -> Map Int Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
idNum Map Int Int
mp
case mbElement of
Just Element
element | Just Int
notesIdNum <- Maybe Int
mbNotesIdNum ->
Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry)
-> ReaderT WriterEnv (StateT WriterState m) Entry
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
FilePath
-> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry
(FilePath
"ppt/notesSlides/_rels/notesSlide" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
notesIdNum FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".xml.rels")
Element
element
Maybe Element
_ -> Maybe Entry
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Entry
forall a. Maybe a
Nothing
slideToSlideRelEntry :: PandocMonad m => Slide -> P m Entry
slideToSlideRelEntry :: forall (m :: * -> *). PandocMonad m => Slide -> P m Entry
slideToSlideRelEntry Slide
slide = do
idNum <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
element <- slideToSlideRelElement slide
elemToEntry ("ppt/slides/_rels/" <> idNumToFilePath idNum <> ".rels") element
linkRelElement :: PandocMonad m => (Int, LinkTarget) -> P m Element
linkRelElement :: forall (m :: * -> *).
PandocMonad m =>
(Int, LinkTarget) -> P m Element
linkRelElement (Int
rIdNum, InternalTarget SlideId
targetId) = do
targetIdNum <- SlideId -> P m Int
forall (m :: * -> *). PandocMonad m => SlideId -> P m Int
getSlideIdNum SlideId
targetId
return $
mknode "Relationship" [ ("Id", "rId" <> tshow rIdNum)
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
, ("Target", "slide" <> tshow targetIdNum <> ".xml")
] ()
linkRelElement (Int
rIdNum, ExternalTarget (Text
url, Text
_)) =
Element -> ReaderT WriterEnv (StateT WriterState m) Element
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ReaderT WriterEnv (StateT WriterState m) Element)
-> Element -> ReaderT WriterEnv (StateT WriterState m) Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"Relationship" [ (Text
"Id", Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
rIdNum)
, (Text
"Type", Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")
, (Text
"Target", Text
url)
, (Text
"TargetMode", Text
"External")
] ()
linkRelElements :: PandocMonad m => M.Map Int LinkTarget -> P m [Element]
linkRelElements :: forall (m :: * -> *).
PandocMonad m =>
Map Int LinkTarget -> P m [Element]
linkRelElements Map Int LinkTarget
mp = ((Int, LinkTarget)
-> ReaderT WriterEnv (StateT WriterState m) Element)
-> [(Int, LinkTarget)]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int, LinkTarget)
-> ReaderT WriterEnv (StateT WriterState m) Element
forall (m :: * -> *).
PandocMonad m =>
(Int, LinkTarget) -> P m Element
linkRelElement (Map Int LinkTarget -> [(Int, LinkTarget)]
forall k a. Map k a -> [(k, a)]
M.toList Map Int LinkTarget
mp)
mediaRelElement :: MediaInfo -> Element
mediaRelElement :: MediaInfo -> Element
mediaRelElement MediaInfo
mInfo =
let ext :: Text
ext = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (MediaInfo -> Maybe Text
mInfoExt MediaInfo
mInfo)
in
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"Relationship" [ (Text
"Id", Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Int -> Text
forall a. Show a => a -> Text
tshow (MediaInfo -> Int
mInfoLocalId MediaInfo
mInfo))
, (Text
"Type", Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/image")
, (Text
"Target", Text
"../media/image" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Int -> Text
forall a. Show a => a -> Text
tshow (MediaInfo -> Int
mInfoGlobalId MediaInfo
mInfo) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ext)
] ()
speakerNotesSlideRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
speakerNotesSlideRelElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
speakerNotesSlideRelElement Slide
slide = do
idNum <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
mp <- asks envSpeakerNotesIdMap
return $ case M.lookup idNum mp of
Maybe Int
Nothing -> Maybe Element
forall a. Maybe a
Nothing
Just Int
n ->
let target :: Text
target = Text
"../notesSlides/notesSlide" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".xml"
in Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"Relationship" [ (Text
"Id", Text
"rId2")
, (Text
"Type", Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesSlide")
, (Text
"Target", Text
target)
] ()
slideToSlideRelElement :: PandocMonad m => Slide -> P m Element
slideToSlideRelElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m Element
slideToSlideRelElement Slide
slide = do
idNum <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
target <- flip fmap getSlideLayouts $
T.pack . ("../slideLayouts/" <>) . takeFileName .
slPath . case slide of
(Slide SlideId
_ MetadataSlide{} SpeakerNotes
_ Maybe FilePath
_) -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
metadata
(Slide SlideId
_ TitleSlide{} SpeakerNotes
_ Maybe FilePath
_) -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
title
(Slide SlideId
_ ContentSlide{} SpeakerNotes
_ Maybe FilePath
_) -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
content
(Slide SlideId
_ TwoColumnSlide{} SpeakerNotes
_ Maybe FilePath
_) -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
twoColumn
(Slide SlideId
_ ComparisonSlide{} SpeakerNotes
_ Maybe FilePath
_) -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
comparison
(Slide SlideId
_ ContentWithCaptionSlide{} SpeakerNotes
_ Maybe FilePath
_) -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
contentWithCaption
(Slide SlideId
_ Layout
BlankSlide SpeakerNotes
_ Maybe FilePath
_) -> SlideLayouts -> SlideLayout
forall a. SlideLayoutsOf a -> a
blank
speakerNotesRels <- maybeToList <$> speakerNotesSlideRelElement slide
linkIds <- gets stLinkIds
mediaIds <- gets stMediaIds
linkRels <- case M.lookup idNum linkIds of
Just Map Int LinkTarget
mp -> Map Int LinkTarget
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (m :: * -> *).
PandocMonad m =>
Map Int LinkTarget -> P m [Element]
linkRelElements Map Int LinkTarget
mp
Maybe (Map Int LinkTarget)
Nothing -> [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
let mediaRels = case Int -> Map Int [MediaInfo] -> Maybe [MediaInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
idNum Map Int [MediaInfo]
mediaIds of
Just [MediaInfo]
mInfos -> (MediaInfo -> Element) -> [MediaInfo] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map MediaInfo -> Element
mediaRelElement [MediaInfo]
mInfos
Maybe [MediaInfo]
Nothing -> []
return $
mknode "Relationships"
[("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
([mknode "Relationship" [ ("Id", "rId1")
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout")
, ("Target", target)] ()
] <> speakerNotesRels <> linkRels <> mediaRels)
slideToSldIdElement ::
PandocMonad m =>
MinimumRId ->
Slide ->
P m Element
slideToSldIdElement :: forall (m :: * -> *). PandocMonad m => Int -> Slide -> P m Element
slideToSldIdElement Int
minimumSlideRId Slide
slide = do
n <- Slide -> P m Int
forall (m :: * -> *). PandocMonad m => Slide -> P m Int
slideNum Slide
slide
let id' = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
255
rId <- slideToRelId minimumSlideRId slide
return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] ()
presentationToSldIdLst ::
PandocMonad m =>
MinimumRId ->
Presentation ->
P m Element
presentationToSldIdLst :: forall (m :: * -> *).
PandocMonad m =>
Int -> Presentation -> P m Element
presentationToSldIdLst Int
minimumSlideRId (Presentation DocProps
_ [Slide]
slides) = do
ids <- (Slide -> ReaderT WriterEnv (StateT WriterState m) Element)
-> [Slide] -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Slide -> ReaderT WriterEnv (StateT WriterState m) Element
forall (m :: * -> *). PandocMonad m => Int -> Slide -> P m Element
slideToSldIdElement Int
minimumSlideRId) [Slide]
slides
return $ mknode "p:sldIdLst" [] 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
refArchive <- (WriterEnv -> Archive)
-> ReaderT WriterEnv (StateT WriterState m) Archive
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
distArchive <- asks envDistArchive
element <- parseXml refArchive distArchive "ppt/presentation.xml"
sldIdLst <- presentationToSldIdLst minSlideRId pres
let modifySldIdLst :: Content -> Content
modifySldIdLst (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
maxSlideRId
notesMasterElem = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:notesMasterIdLst" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode
Text
"p:notesMasterId"
[(Text
"r:id", Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
notesMasterRId)]
()
]
removeUnwantedMaster' :: Content -> [Content]
removeUnwantedMaster' (Elem Element
e) = case Element -> QName
elName Element
e of
(QName Text
"notesMasterIdLst" Maybe Text
_ Maybe Text
_) -> []
(QName Text
"handoutMasterIdLst" Maybe Text
_ Maybe Text
_) -> []
QName
_ -> [Element -> Content
Elem Element
e]
removeUnwantedMaster' Content
ct = [Content
ct]
removeUnwantedMaster :: [Content] -> [Content]
removeUnwantedMaster = (Content -> [Content]) -> [Content] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Content -> [Content]
removeUnwantedMaster'
insertNotesMaster' :: Content -> [Content]
insertNotesMaster' (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 = if Presentation -> Bool
presHasSpeakerNotes Presentation
pres
then (Content -> [Content]) -> [Content] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Content -> [Content]
insertNotesMaster'
else [Content] -> [Content]
forall a. a -> a
id
updateRIds :: Content -> Content
updateRIds (Elem Element
el) =
Element -> Content
Elem (Element
el { elAttribs = fmap updateRIdAttribute (elAttribs el)
, elContent = fmap updateRIds (elContent el)
})
updateRIds Content
content = Content
content
updateRIdAttribute :: XML.Attr -> XML.Attr
updateRIdAttribute Attr
attr = Attr -> Maybe Attr -> Attr
forall a. a -> Maybe a -> a
fromMaybe Attr
attr (Maybe Attr -> Attr) -> Maybe Attr -> Attr
forall a b. (a -> b) -> a -> b
$ do
oldValue <- case Attr -> QName
attrKey Attr
attr of
QName Text
"id" Maybe Text
_ (Just Text
"r") ->
Text -> Text -> Maybe Text
T.stripPrefix Text
"rId" (Attr -> Text
attrVal Attr
attr)
Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Integer -> Int) -> Maybe Integer -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Integer -> Maybe Int)
-> (Text -> Maybe Integer) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Integer
readTextAsInteger
QName
_ -> Maybe Int
forall a. Maybe a
Nothing
let newValue = PresentationRIdUpdateData -> Int -> Int
updatePresentationRId PresentationRIdUpdateData
presentationUpdateRIdData Int
oldValue
pure attr {attrVal = "rId" <> T.pack (show newValue)}
newContent = [Content] -> [Content]
insertNotesMaster ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$
[Content] -> [Content]
removeUnwantedMaster ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$
(Content -> Content
modifySldIdLst (Content -> Content) -> (Content -> Content) -> Content -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Content
updateRIds) (Content -> Content) -> [Content] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Element -> [Content]
elContent Element
element
return $ element{elContent = newContent}
presentationToPresEntry :: PandocMonad m => PresentationRIdUpdateData -> Presentation -> P m Entry
presentationToPresEntry :: forall (m :: * -> *).
PandocMonad m =>
PresentationRIdUpdateData -> Presentation -> P m Entry
presentationToPresEntry PresentationRIdUpdateData
presentationRIdUpdateData Presentation
pres =
PresentationRIdUpdateData -> Presentation -> P m Element
forall (m :: * -> *).
PandocMonad m =>
PresentationRIdUpdateData -> Presentation -> P m Element
presentationToPresentationElement PresentationRIdUpdateData
presentationRIdUpdateData Presentation
pres P m Element
-> (Element -> ReaderT WriterEnv (StateT WriterState m) Entry)
-> ReaderT WriterEnv (StateT WriterState m) Entry
forall a b.
ReaderT WriterEnv (StateT WriterState m) a
-> (a -> ReaderT WriterEnv (StateT WriterState m) b)
-> ReaderT WriterEnv (StateT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
FilePath
-> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
"ppt/presentation.xml"
docPropsElement :: PandocMonad m => DocProps -> P m Element
docPropsElement :: forall (m :: * -> *). PandocMonad m => DocProps -> P m Element
docPropsElement DocProps
docProps = do
utctime <- (WriterEnv -> UTCTime)
-> ReaderT WriterEnv (StateT WriterState m) UTCTime
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> UTCTime
envUTCTime
let keywords = case DocProps -> Maybe [Text]
dcKeywords DocProps
docProps of
Just [Text]
xs -> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
xs
Maybe [Text]
Nothing -> Text
""
return $
mknode "cp:coreProperties"
[("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
,("xmlns:dc","http://purl.org/dc/elements/1.1/")
,("xmlns:dcterms","http://purl.org/dc/terms/")
,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")]
$
mknode "dc:title" [] (fromMaybe "" $ dcTitle docProps)
:
mknode "dc:creator" [] (fromMaybe "" $ dcCreator docProps)
:
mknode "cp:keywords" [] keywords
: ( [mknode "dc:subject" [] $ fromMaybe "" $ dcSubject docProps | isJust (dcSubject docProps)])
<> ( [mknode "dc:description" [] $ fromMaybe "" $ dcDescription docProps | isJust (dcDescription docProps)])
<> ( [mknode "cp:category" [] $ fromMaybe "" $ cpCategory docProps | isJust (cpCategory docProps)])
<> (\Text
x -> [ Text -> [(Text, Text)] -> Text -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"dcterms:created" [(Text
"xsi:type",Text
"dcterms:W3CDTF")] Text
x
, Text -> [(Text, Text)] -> Text -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"dcterms:modified" [(Text
"xsi:type",Text
"dcterms:W3CDTF")] Text
x
]) (T.pack $ formatTime defaultTimeLocale "%FT%XZ" utctime)
docPropsToEntry :: PandocMonad m => DocProps -> P m Entry
docPropsToEntry :: forall (m :: * -> *). PandocMonad m => DocProps -> P m Entry
docPropsToEntry DocProps
docProps = DocProps -> P m Element
forall (m :: * -> *). PandocMonad m => DocProps -> P m Element
docPropsElement DocProps
docProps P m Element
-> (Element -> ReaderT WriterEnv (StateT WriterState m) Entry)
-> ReaderT WriterEnv (StateT WriterState m) Entry
forall a b.
ReaderT WriterEnv (StateT WriterState m) a
-> (a -> ReaderT WriterEnv (StateT WriterState m) b)
-> ReaderT WriterEnv (StateT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
FilePath
-> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
"docProps/core.xml"
docCustomPropsElement :: PandocMonad m => DocProps -> P m Element
docCustomPropsElement :: forall (m :: * -> *). PandocMonad m => DocProps -> P m Element
docCustomPropsElement DocProps
docProps = do
let mkCustomProp :: (Text, t) -> a -> Element
mkCustomProp (Text
k, t
v) a
pid = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"property"
[(Text
"fmtid",Text
"{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
,(Text
"pid", a -> Text
forall a. Show a => a -> Text
tshow a
pid)
,(Text
"name", Text
k)] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> t -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"vt:lpwstr" [] t
v
Element -> ReaderT WriterEnv (StateT WriterState m) Element
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ReaderT WriterEnv (StateT WriterState m) Element)
-> Element -> ReaderT WriterEnv (StateT WriterState m) Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"Properties"
[(Text
"xmlns",Text
"http://schemas.openxmlformats.org/officeDocument/2006/custom-properties")
,(Text
"xmlns:vt",Text
"http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")
] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Int -> Element)
-> [(Text, Text)] -> [Int] -> [Element]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text, Text) -> Int -> Element
forall {t} {a}. (Node t, Show a) => (Text, t) -> a -> Element
mkCustomProp ([(Text, Text)] -> Maybe [(Text, Text)] -> [(Text, Text)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(Text, Text)] -> [(Text, Text)])
-> Maybe [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ DocProps -> Maybe [(Text, Text)]
customProperties DocProps
docProps) [(Int
2 :: Int)..]
docCustomPropsToEntry :: PandocMonad m => DocProps -> P m Entry
docCustomPropsToEntry :: forall (m :: * -> *). PandocMonad m => DocProps -> P m Entry
docCustomPropsToEntry DocProps
docProps = DocProps -> P m Element
forall (m :: * -> *). PandocMonad m => DocProps -> P m Element
docCustomPropsElement DocProps
docProps P m Element
-> (Element -> ReaderT WriterEnv (StateT WriterState m) Entry)
-> ReaderT WriterEnv (StateT WriterState m) Entry
forall a b.
ReaderT WriterEnv (StateT WriterState m) a
-> (a -> ReaderT WriterEnv (StateT WriterState m) b)
-> ReaderT WriterEnv (StateT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
FilePath
-> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
"docProps/custom.xml"
viewPropsElement :: PandocMonad m => P m Element
viewPropsElement :: forall (m :: * -> *). PandocMonad m => P m Element
viewPropsElement = do
refArchive <- (WriterEnv -> Archive)
-> ReaderT WriterEnv (StateT WriterState m) Archive
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Archive
envRefArchive
distArchive <- asks envDistArchive
viewPrElement <- parseXml refArchive distArchive "ppt/viewProps.xml"
let notLastView :: XML.Attr -> Bool
notLastView Attr
attr =
QName -> Text
qName (Attr -> QName
attrKey Attr
attr) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"lastView"
return $
viewPrElement {elAttribs = filter notLastView (elAttribs viewPrElement)}
makeViewPropsEntry :: PandocMonad m => P m Entry
makeViewPropsEntry :: forall (m :: * -> *). PandocMonad m => P m Entry
makeViewPropsEntry = P m Element
forall (m :: * -> *). PandocMonad m => P m Element
viewPropsElement P m Element
-> (Element -> ReaderT WriterEnv (StateT WriterState m) Entry)
-> ReaderT WriterEnv (StateT WriterState m) Entry
forall a b.
ReaderT WriterEnv (StateT WriterState m) a
-> (a -> ReaderT WriterEnv (StateT WriterState m) b)
-> ReaderT WriterEnv (StateT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath
-> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
"ppt/viewProps.xml"
defaultContentTypeToElem :: DefaultContentType -> Element
defaultContentTypeToElem :: DefaultContentType -> Element
defaultContentTypeToElem DefaultContentType
dct =
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"Default"
[(Text
"Extension", DefaultContentType -> Text
defContentTypesExt DefaultContentType
dct),
(Text
"ContentType", DefaultContentType -> Text
defContentTypesType DefaultContentType
dct)]
()
overrideContentTypeToElem :: OverrideContentType -> Element
overrideContentTypeToElem :: OverrideContentType -> Element
overrideContentTypeToElem OverrideContentType
oct =
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"Override"
[(Text
"PartName", FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ OverrideContentType -> FilePath
overrideContentTypesPart OverrideContentType
oct),
(Text
"ContentType", OverrideContentType -> Text
overrideContentTypesType OverrideContentType
oct)]
()
contentTypesToElement :: ContentTypes -> Element
contentTypesToElement :: ContentTypes -> Element
contentTypesToElement ContentTypes
ct =
let ns :: Text
ns = Text
"http://schemas.openxmlformats.org/package/2006/content-types"
in
Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"Types" [(Text
"xmlns", Text
ns)] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
(DefaultContentType -> Element)
-> [DefaultContentType] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map DefaultContentType -> Element
defaultContentTypeToElem (ContentTypes -> [DefaultContentType]
contentTypesDefaults ContentTypes
ct) [Element] -> [Element] -> [Element]
forall a. Semigroup a => a -> a -> a
<>
(OverrideContentType -> Element)
-> [OverrideContentType] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map OverrideContentType -> Element
overrideContentTypeToElem (ContentTypes -> [OverrideContentType]
contentTypesOverrides ContentTypes
ct)
data DefaultContentType = DefaultContentType
{ DefaultContentType -> Text
defContentTypesExt :: T.Text
, DefaultContentType -> Text
defContentTypesType:: MimeType
}
deriving (Int -> DefaultContentType -> FilePath -> FilePath
[DefaultContentType] -> FilePath -> FilePath
DefaultContentType -> FilePath
(Int -> DefaultContentType -> FilePath -> FilePath)
-> (DefaultContentType -> FilePath)
-> ([DefaultContentType] -> FilePath -> FilePath)
-> Show DefaultContentType
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> DefaultContentType -> FilePath -> FilePath
showsPrec :: Int -> DefaultContentType -> FilePath -> FilePath
$cshow :: DefaultContentType -> FilePath
show :: DefaultContentType -> FilePath
$cshowList :: [DefaultContentType] -> FilePath -> FilePath
showList :: [DefaultContentType] -> FilePath -> FilePath
Show, DefaultContentType -> DefaultContentType -> Bool
(DefaultContentType -> DefaultContentType -> Bool)
-> (DefaultContentType -> DefaultContentType -> Bool)
-> Eq DefaultContentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefaultContentType -> DefaultContentType -> Bool
== :: DefaultContentType -> DefaultContentType -> Bool
$c/= :: DefaultContentType -> DefaultContentType -> Bool
/= :: DefaultContentType -> DefaultContentType -> Bool
Eq)
data OverrideContentType = OverrideContentType
{ OverrideContentType -> FilePath
overrideContentTypesPart :: FilePath
, OverrideContentType -> Text
overrideContentTypesType :: MimeType
}
deriving (Int -> OverrideContentType -> FilePath -> FilePath
[OverrideContentType] -> FilePath -> FilePath
OverrideContentType -> FilePath
(Int -> OverrideContentType -> FilePath -> FilePath)
-> (OverrideContentType -> FilePath)
-> ([OverrideContentType] -> FilePath -> FilePath)
-> Show OverrideContentType
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> OverrideContentType -> FilePath -> FilePath
showsPrec :: Int -> OverrideContentType -> FilePath -> FilePath
$cshow :: OverrideContentType -> FilePath
show :: OverrideContentType -> FilePath
$cshowList :: [OverrideContentType] -> FilePath -> FilePath
showList :: [OverrideContentType] -> FilePath -> FilePath
Show, OverrideContentType -> OverrideContentType -> Bool
(OverrideContentType -> OverrideContentType -> Bool)
-> (OverrideContentType -> OverrideContentType -> Bool)
-> Eq OverrideContentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OverrideContentType -> OverrideContentType -> Bool
== :: OverrideContentType -> OverrideContentType -> Bool
$c/= :: OverrideContentType -> OverrideContentType -> Bool
/= :: OverrideContentType -> OverrideContentType -> Bool
Eq)
data ContentTypes = ContentTypes { ContentTypes -> [DefaultContentType]
contentTypesDefaults :: [DefaultContentType]
, ContentTypes -> [OverrideContentType]
contentTypesOverrides :: [OverrideContentType]
}
deriving (Int -> ContentTypes -> FilePath -> FilePath
[ContentTypes] -> FilePath -> FilePath
ContentTypes -> FilePath
(Int -> ContentTypes -> FilePath -> FilePath)
-> (ContentTypes -> FilePath)
-> ([ContentTypes] -> FilePath -> FilePath)
-> Show ContentTypes
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ContentTypes -> FilePath -> FilePath
showsPrec :: Int -> ContentTypes -> FilePath -> FilePath
$cshow :: ContentTypes -> FilePath
show :: ContentTypes -> FilePath
$cshowList :: [ContentTypes] -> FilePath -> FilePath
showList :: [ContentTypes] -> FilePath -> FilePath
Show, ContentTypes -> ContentTypes -> Bool
(ContentTypes -> ContentTypes -> Bool)
-> (ContentTypes -> ContentTypes -> Bool) -> Eq ContentTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContentTypes -> ContentTypes -> Bool
== :: ContentTypes -> ContentTypes -> Bool
$c/= :: ContentTypes -> ContentTypes -> Bool
/= :: ContentTypes -> ContentTypes -> Bool
Eq)
contentTypesToEntry :: PandocMonad m => ContentTypes -> P m Entry
contentTypesToEntry :: forall (m :: * -> *). PandocMonad m => ContentTypes -> P m Entry
contentTypesToEntry ContentTypes
ct = FilePath -> Element -> P m Entry
forall (m :: * -> *).
PandocMonad m =>
FilePath -> Element -> P m Entry
elemToEntry FilePath
"[Content_Types].xml" (Element -> P m Entry) -> Element -> P m Entry
forall a b. (a -> b) -> a -> b
$ ContentTypes -> Element
contentTypesToElement ContentTypes
ct
pathToOverride :: FilePath -> Maybe OverrideContentType
pathToOverride :: FilePath -> Maybe OverrideContentType
pathToOverride FilePath
fp = FilePath -> Text -> OverrideContentType
OverrideContentType (FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp) (Text -> OverrideContentType)
-> Maybe Text -> Maybe OverrideContentType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Maybe Text
getContentType FilePath
fp
mediaFileContentType :: FilePath -> Maybe DefaultContentType
mediaFileContentType :: FilePath -> Maybe DefaultContentType
mediaFileContentType FilePath
fp = case FilePath -> FilePath
takeExtension FilePath
fp of
Char
'.' : FilePath
ext -> DefaultContentType -> Maybe DefaultContentType
forall a. a -> Maybe a
Just (DefaultContentType -> Maybe DefaultContentType)
-> DefaultContentType -> Maybe DefaultContentType
forall a b. (a -> b) -> a -> b
$
DefaultContentType { defContentTypesExt :: Text
defContentTypesExt = FilePath -> Text
T.pack FilePath
ext
, defContentTypesType :: Text
defContentTypesType =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"application/octet-stream" (FilePath -> Maybe Text
getMimeType FilePath
fp)
}
FilePath
_ -> Maybe DefaultContentType
forall a. Maybe a
Nothing
mediaContentType :: MediaInfo -> Maybe DefaultContentType
mediaContentType :: MediaInfo -> Maybe DefaultContentType
mediaContentType MediaInfo
mInfo
| Just Text
t <- MediaInfo -> Maybe Text
mInfoExt MediaInfo
mInfo
, Just (Char
'.', Text
ext) <- Text -> Maybe (Char, Text)
T.uncons Text
t =
DefaultContentType -> Maybe DefaultContentType
forall a. a -> Maybe a
Just (DefaultContentType -> Maybe DefaultContentType)
-> DefaultContentType -> Maybe DefaultContentType
forall a b. (a -> b) -> a -> b
$ DefaultContentType { defContentTypesExt :: Text
defContentTypesExt = Text
ext
, defContentTypesType :: Text
defContentTypesType =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"application/octet-stream" (MediaInfo -> Maybe Text
mInfoMimeType MediaInfo
mInfo)
}
| Bool
otherwise = Maybe DefaultContentType
forall a. Maybe a
Nothing
getSpeakerNotesFilePaths :: PandocMonad m => P m [FilePath]
getSpeakerNotesFilePaths :: forall (m :: * -> *). PandocMonad m => P m [FilePath]
getSpeakerNotesFilePaths = do
mp <- (WriterEnv -> Map Int Int)
-> ReaderT WriterEnv (StateT WriterState m) (Map Int Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Map Int Int
envSpeakerNotesIdMap
let notesIdNums = Map Int Int -> [Int]
forall k a. Map k a -> [a]
M.elems Map Int Int
mp
return $ map (\Int
n -> FilePath
"ppt/notesSlides/notesSlide" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".xml")
notesIdNums
presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes
presentationToContentTypes :: forall (m :: * -> *).
PandocMonad m =>
Presentation -> P m ContentTypes
presentationToContentTypes p :: Presentation
p@(Presentation DocProps
_ [Slide]
slides) = do
mediaInfos <- [[MediaInfo]] -> [MediaInfo]
forall a. Monoid a => [a] -> a
mconcat ([[MediaInfo]] -> [MediaInfo])
-> (Map Int [MediaInfo] -> [[MediaInfo]])
-> Map Int [MediaInfo]
-> [MediaInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int [MediaInfo] -> [[MediaInfo]]
forall k a. Map k a -> [a]
M.elems (Map Int [MediaInfo] -> [MediaInfo])
-> ReaderT WriterEnv (StateT WriterState m) (Map Int [MediaInfo])
-> ReaderT WriterEnv (StateT WriterState m) [MediaInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> Map Int [MediaInfo])
-> ReaderT WriterEnv (StateT WriterState m) (Map Int [MediaInfo])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int [MediaInfo]
stMediaIds
filePaths <- patternsToFilePaths $ inheritedPatterns p
let mediaFps = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pattern -> FilePath -> Bool
match (FilePath -> Pattern
compile FilePath
"ppt/media/image*")) [FilePath]
filePaths
let defaults = [ Text -> Text -> DefaultContentType
DefaultContentType Text
"xml" Text
"application/xml"
, Text -> Text -> DefaultContentType
DefaultContentType Text
"rels" Text
"application/vnd.openxmlformats-package.relationships+xml"
]
mediaDefaults = [DefaultContentType] -> [DefaultContentType]
forall a. Eq a => [a] -> [a]
nub ([DefaultContentType] -> [DefaultContentType])
-> [DefaultContentType] -> [DefaultContentType]
forall a b. (a -> b) -> a -> b
$
(MediaInfo -> Maybe DefaultContentType)
-> [MediaInfo] -> [DefaultContentType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MediaInfo -> Maybe DefaultContentType
mediaContentType [MediaInfo]
mediaInfos [DefaultContentType]
-> [DefaultContentType] -> [DefaultContentType]
forall a. Semigroup a => a -> a -> a
<>
(FilePath -> Maybe DefaultContentType)
-> [FilePath] -> [DefaultContentType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe DefaultContentType
mediaFileContentType [FilePath]
mediaFps
inheritedOverrides = (FilePath -> Maybe OverrideContentType)
-> [FilePath] -> [OverrideContentType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe OverrideContentType
pathToOverride [FilePath]
filePaths
createdOverrides = (FilePath -> Maybe OverrideContentType)
-> [FilePath] -> [OverrideContentType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe OverrideContentType
pathToOverride [ FilePath
"docProps/core.xml"
, FilePath
"docProps/custom.xml"
, FilePath
"ppt/presentation.xml"
, FilePath
"ppt/viewProps.xml"
]
relativePaths <- mapM slideToFilePath slides
let slideOverrides = (FilePath -> Maybe OverrideContentType)
-> [FilePath] -> [OverrideContentType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\FilePath
fp -> FilePath -> Maybe OverrideContentType
pathToOverride (FilePath -> Maybe OverrideContentType)
-> FilePath -> Maybe OverrideContentType
forall a b. (a -> b) -> a -> b
$ FilePath
"ppt/slides/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp)
[FilePath]
relativePaths
speakerNotesOverrides <- mapMaybe pathToOverride <$> getSpeakerNotesFilePaths
return $ ContentTypes
(defaults <> mediaDefaults)
(inheritedOverrides <> createdOverrides <> slideOverrides <> speakerNotesOverrides)
presML :: T.Text
presML :: Text
presML = Text
"application/vnd.openxmlformats-officedocument.presentationml"
noPresML :: T.Text
noPresML :: Text
noPresML = Text
"application/vnd.openxmlformats-officedocument"
getContentType :: FilePath -> Maybe MimeType
getContentType :: FilePath -> Maybe Text
getContentType FilePath
fp
| FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"ppt/presentation.xml" = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
presML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".presentation.main+xml"
| FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"ppt/presProps.xml" = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
presML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".presProps+xml"
| FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"ppt/viewProps.xml" = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
presML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".viewProps+xml"
| FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"ppt/tableStyles.xml" = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
presML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".tableStyles+xml"
| FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"docProps/core.xml" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"application/vnd.openxmlformats-package.core-properties+xml"
| FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"docProps/custom.xml" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"application/vnd.openxmlformats-officedocument.custom-properties+xml"
| FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"docProps/app.xml" = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
noPresML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".extended-properties+xml"
| [FilePath
"ppt", FilePath
"slideMasters", FilePath
f] <- FilePath -> [FilePath]
splitDirectories FilePath
fp
, (FilePath
_, FilePath
".xml") <- FilePath -> (FilePath, FilePath)
splitExtension FilePath
f =
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
presML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".slideMaster+xml"
| [FilePath
"ppt", FilePath
"slides", FilePath
f] <- FilePath -> [FilePath]
splitDirectories FilePath
fp
, (FilePath
_, FilePath
".xml") <- FilePath -> (FilePath, FilePath)
splitExtension FilePath
f =
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
presML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".slide+xml"
| [FilePath
"ppt", FilePath
"notesMasters", FilePath
f] <- FilePath -> [FilePath]
splitDirectories FilePath
fp
, (FilePath
_, FilePath
".xml") <- FilePath -> (FilePath, FilePath)
splitExtension FilePath
f =
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
presML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".notesMaster+xml"
| [FilePath
"ppt", FilePath
"notesSlides", FilePath
f] <- FilePath -> [FilePath]
splitDirectories FilePath
fp
, (FilePath
_, FilePath
".xml") <- FilePath -> (FilePath, FilePath)
splitExtension FilePath
f =
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
presML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".notesSlide+xml"
| [FilePath
"ppt", FilePath
"theme", FilePath
f] <- FilePath -> [FilePath]
splitDirectories FilePath
fp
, (FilePath
_, FilePath
".xml") <- FilePath -> (FilePath, FilePath)
splitExtension FilePath
f =
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
noPresML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".theme+xml"
| [FilePath
"ppt", FilePath
"slideLayouts", FilePath
_] <- FilePath -> [FilePath]
splitDirectories FilePath
fp=
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
presML Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".slideLayout+xml"
| Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing
autoNumAttrs :: ListAttributes -> [(Text, Text)]
autoNumAttrs :: ListAttributes -> [(Text, Text)]
autoNumAttrs (Int
startNum, ListNumberStyle
numStyle, ListNumberDelim
numDelim) =
[(Text, Text)]
numAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
typeAttr
where
numAttr :: [(Text, Text)]
numAttr = [(Text
"startAt", Int -> Text
forall a. Show a => a -> Text
tshow Int
startNum) | Int
startNum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1]
typeAttr :: [(Text, Text)]
typeAttr = [(Text
"type", Text
typeString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
delimString)]
typeString :: Text
typeString = case ListNumberStyle
numStyle of
ListNumberStyle
Decimal -> Text
"arabic"
ListNumberStyle
UpperAlpha -> Text
"alphaUc"
ListNumberStyle
LowerAlpha -> Text
"alphaLc"
ListNumberStyle
UpperRoman -> Text
"romanUc"
ListNumberStyle
LowerRoman -> Text
"romanLc"
ListNumberStyle
_ -> Text
"arabic"
delimString :: Text
delimString = case ListNumberDelim
numDelim of
ListNumberDelim
Period -> Text
"Period"
ListNumberDelim
OneParen -> Text
"ParenR"
ListNumberDelim
TwoParens -> Text
"ParenBoth"
ListNumberDelim
_ -> Text
"Period"
incrementalAnimation ::
NonEmpty (ShapeId, NonEmpty (Integer, Integer)) ->
Element
incrementalAnimation :: NonEmpty (Integer, NonEmpty (Integer, Integer)) -> Element
incrementalAnimation NonEmpty (Integer, NonEmpty (Integer, Integer))
indices = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:timing" [] [Element
tnLst, Element
bldLst]
where
triples :: NonEmpty (ShapeId, Integer, Integer)
triples :: NonEmpty (Integer, Integer, Integer)
triples = do
(shapeId, paragraphIds) <- NonEmpty (Integer, NonEmpty (Integer, Integer))
indices
(start, end) <- paragraphIds
pure (shapeId, start, end)
tnLst :: Element
tnLst = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:tnLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:par" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cTn" [ (Text
"id", Text
"1")
, (Text
"dur", Text
"indefinite")
, (Text
"restart", Text
"never")
, (Text
"nodeType", Text
"tmRoot")
]
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:childTnLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:seq" [ (Text
"concurrent", Text
"1")
, (Text
"nextAc", Text
"seek")
]
[ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cTn" [ (Text
"id", Text
"2")
, (Text
"dur", Text
"indefinite")
, (Text
"nodeType", Text
"mainSeq")
]
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:childTnLst" []
([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Integer -> (Integer, Integer, Integer) -> Element)
-> [Integer] -> [(Integer, Integer, Integer)] -> [Element]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> (Integer, Integer, Integer) -> Element
makePar [Integer
3, Integer
7 ..] (NonEmpty (Integer, Integer, Integer)
-> [(Integer, Integer, Integer)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Integer, Integer, Integer)
triples)
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:prevCondLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cond" ([(Text
"evt", Text
"onPrev"), (Text
"delay", Text
"0")])
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:tgtEl" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sldTgt" [] ()
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:nextCondLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cond" ([(Text
"evt", Text
"onNext"), (Text
"delay", Text
"0")])
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:tgtEl" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:sldTgt" [] ()
]
bldLst :: Element
bldLst = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:bldLst" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:bldP" [ (Text
"spid", FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
shapeId))
, (Text
"grpId", Text
"0")
, (Text
"uiExpand", Text
"1")
, (Text
"build", Text
"p")
]
() | (Integer
shapeId, NonEmpty (Integer, Integer)
_) <- NonEmpty (Integer, NonEmpty (Integer, Integer))
-> [(Integer, NonEmpty (Integer, Integer))]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Integer, NonEmpty (Integer, Integer))
indices
]
makePar :: Integer -> (ShapeId, Integer, Integer) -> Element
makePar :: Integer -> (Integer, Integer, Integer) -> Element
makePar Integer
nextId (Integer
shapeId, Integer
start, Integer
end) =
Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:par" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cTn" [(Text
"id", FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
nextId)), (Text
"fill", Text
"hold")]
[ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:stCondLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cond" [(Text
"delay", Text
"indefinite")] ()
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:childTnLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:par" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cTn" [ (Text
"id", FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer
nextId Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)))
, (Text
"fill", Text
"hold")
]
[ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:stCondLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cond" [(Text
"delay", Text
"0")] ()
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:childTnLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:par" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cTn" [ (Text
"id", FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer
nextId Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2)))
, (Text
"presetID", Text
"1")
, (Text
"presetClass", Text
"entr")
, (Text
"presetSubtype", Text
"0")
, (Text
"fill", Text
"hold")
, (Text
"grpId", Text
"0")
, (Text
"nodeType", Text
"clickEffect")
]
[ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:stCondLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cond" [(Text
"delay", Text
"0")] ()
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:childTnLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:set" []
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cBhvr" []
[ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cTn" [ (Text
"id", FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer
nextId Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
3)))
, (Text
"dur", Text
"1")
, (Text
"fill", Text
"hold")
]
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:stCondLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:cond" [(Text
"delay", Text
"0")] ()
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:tgtEl" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:spTgt" [(Text
"spid", FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
shapeId))]
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:txEl" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:pRg" [ (Text
"st", FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
start))
, (Text
"end", FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
end))]
()
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:attrNameLst" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Text -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:attrName" [] (Text
"style.visibility" :: Text)
]
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:to" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"p:strVal" [(Text
"val", Text
"visible")] ()
]
]
]
]