|
Packit Service |
d2f85f |
{-# LANGUAGE PatternGuards, MultiWayIf, OverloadedStrings #-}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
{-
|
|
Packit Service |
d2f85f |
Copyright (C) 2017 Jesse Rosenthal <jrosenthal@jhu.edu>
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
This program is free software; you can redistribute it and/or modify
|
|
Packit Service |
d2f85f |
it under the terms of the GNU General Public License as published by
|
|
Packit Service |
d2f85f |
the Free Software Foundation; either version 2 of the License, or
|
|
Packit Service |
d2f85f |
(at your option) any later version.
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
This program is distributed in the hope that it will be useful,
|
|
Packit Service |
d2f85f |
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Packit Service |
d2f85f |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
Packit Service |
d2f85f |
GNU General Public License for more details.
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
You should have received a copy of the GNU General Public License
|
|
Packit Service |
d2f85f |
along with this program; if not, write to the Free Software
|
|
Packit Service |
d2f85f |
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
Packit Service |
d2f85f |
-}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
{- |
|
|
Packit Service |
d2f85f |
Module : Text.Pandoc.Writers.Powerpoint
|
|
Packit Service |
d2f85f |
Copyright : Copyright (C) 2017 Jesse Rosenthal
|
|
Packit Service |
d2f85f |
License : GNU GPL, version 2 or above
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
|
|
Packit Service |
d2f85f |
Stability : alpha
|
|
Packit Service |
d2f85f |
Portability : portable
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
Conversion of 'Pandoc' documents to powerpoint (pptx).
|
|
Packit Service |
d2f85f |
-}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
module Text.Pandoc.Writers.Powerpoint (writePowerpoint) where
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
import Control.Monad.Except (throwError)
|
|
Packit Service |
d2f85f |
import Control.Monad.Reader
|
|
Packit Service |
d2f85f |
import Control.Monad.State
|
|
Packit Service |
d2f85f |
import Codec.Archive.Zip
|
|
Packit Service |
d2f85f |
import Data.List (intercalate, stripPrefix, isPrefixOf, nub)
|
|
Packit Service |
d2f85f |
-- import Control.Monad (mplus)
|
|
Packit Service |
d2f85f |
import Data.Default
|
|
Packit Service |
d2f85f |
import Data.Time.Clock (UTCTime)
|
|
Packit Service |
d2f85f |
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
|
|
Packit Service |
d2f85f |
import System.FilePath.Posix (splitDirectories, splitExtension)
|
|
Packit Service |
d2f85f |
import Text.XML.Light
|
|
Packit Service |
d2f85f |
import Text.Pandoc.Definition
|
|
Packit Service |
d2f85f |
import qualified Text.Pandoc.UTF8 as UTF8
|
|
Packit Service |
d2f85f |
import Text.Pandoc.Class (PandocMonad)
|
|
Packit Service |
d2f85f |
import Text.Pandoc.Error (PandocError(..))
|
|
Packit Service |
d2f85f |
import qualified Text.Pandoc.Class as P
|
|
Packit Service |
d2f85f |
import Text.Pandoc.Options
|
|
Packit Service |
d2f85f |
import Text.Pandoc.MIME
|
|
Packit Service |
d2f85f |
import Text.Pandoc.Logging
|
|
Packit Service |
d2f85f |
import qualified Data.ByteString.Lazy as BL
|
|
Packit Service |
d2f85f |
-- import qualified Data.ByteString.Lazy.Char8 as BL8
|
|
Packit Service |
d2f85f |
-- import qualified Text.Pandoc.UTF8 as UTF8
|
|
Packit Service |
d2f85f |
import Text.Pandoc.Walk
|
|
Packit Service |
d2f85f |
import Text.Pandoc.Writers.Shared (fixDisplayMath)
|
|
Packit Service |
d2f85f |
import Text.Pandoc.Writers.OOXML
|
|
Packit Service |
d2f85f |
import qualified Data.Map as M
|
|
Packit Service |
d2f85f |
import Data.Maybe (mapMaybe, listToMaybe)
|
|
Packit Service |
d2f85f |
import Text.Pandoc.ImageSize
|
|
Packit Service |
d2f85f |
import Control.Applicative ((<|>))
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
import Text.TeXMath
|
|
Packit Service |
d2f85f |
import Text.Pandoc.Writers.Math (convertMath)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
writePowerpoint :: (PandocMonad m)
|
|
Packit Service |
d2f85f |
=> WriterOptions -- ^ Writer options
|
|
Packit Service |
d2f85f |
-> Pandoc -- ^ Document to convert
|
|
Packit Service |
d2f85f |
-> m BL.ByteString
|
|
Packit Service |
d2f85f |
writePowerpoint opts (Pandoc meta blks) = do
|
|
Packit Service |
d2f85f |
let blks' = walk fixDisplayMath blks
|
|
Packit Service |
d2f85f |
distArchive <- (toArchive . BL.fromStrict) <$>
|
|
Packit Service |
d2f85f |
P.readDefaultDataFile "reference.pptx"
|
|
Packit Service |
d2f85f |
refArchive <- case writerReferenceDoc opts of
|
|
Packit Service |
d2f85f |
Just f -> toArchive <$> P.readFileLazy f
|
|
Packit Service |
d2f85f |
Nothing -> (toArchive . BL.fromStrict) <$>
|
|
Packit Service |
d2f85f |
P.readDataFile "reference.pptx"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
utctime <- P.getCurrentTime
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let env = def { envMetadata = meta
|
|
Packit Service |
d2f85f |
, envRefArchive = refArchive
|
|
Packit Service |
d2f85f |
, envDistArchive = distArchive
|
|
Packit Service |
d2f85f |
, envUTCTime = utctime
|
|
Packit Service |
d2f85f |
, envOpts = opts
|
|
Packit Service |
d2f85f |
, envSlideLevel = case writerSlideLevel opts of
|
|
Packit Service |
d2f85f |
Just n -> n
|
|
Packit Service |
d2f85f |
Nothing -> 2
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
runP env def $ do pres <- blocksToPresentation blks'
|
|
Packit Service |
d2f85f |
archv <- presentationToArchive pres
|
|
Packit Service |
d2f85f |
return $ fromArchive archv
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
|
|
Packit Service |
d2f85f |
concatMapM f xs = liftM concat (mapM f xs)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data WriterEnv = WriterEnv { envMetadata :: Meta
|
|
Packit Service |
d2f85f |
, envRunProps :: RunProps
|
|
Packit Service |
d2f85f |
, envParaProps :: ParaProps
|
|
Packit Service |
d2f85f |
, envSlideLevel :: Int
|
|
Packit Service |
d2f85f |
, envRefArchive :: Archive
|
|
Packit Service |
d2f85f |
, envDistArchive :: Archive
|
|
Packit Service |
d2f85f |
, envUTCTime :: UTCTime
|
|
Packit Service |
d2f85f |
, envOpts :: WriterOptions
|
|
Packit Service |
d2f85f |
, envPresentationSize :: PresentationSize
|
|
Packit Service |
d2f85f |
, envSlideHasHeader :: Bool
|
|
Packit Service |
d2f85f |
, envInList :: Bool
|
|
Packit Service |
d2f85f |
, envInNoteSlide :: Bool
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
deriving (Show)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
instance Default WriterEnv where
|
|
Packit Service |
d2f85f |
def = WriterEnv { envMetadata = mempty
|
|
Packit Service |
d2f85f |
, envRunProps = def
|
|
Packit Service |
d2f85f |
, envParaProps = def
|
|
Packit Service |
d2f85f |
, envSlideLevel = 2
|
|
Packit Service |
d2f85f |
, envRefArchive = emptyArchive
|
|
Packit Service |
d2f85f |
, envDistArchive = emptyArchive
|
|
Packit Service |
d2f85f |
, envUTCTime = posixSecondsToUTCTime 0
|
|
Packit Service |
d2f85f |
, envOpts = def
|
|
Packit Service |
d2f85f |
, envPresentationSize = def
|
|
Packit Service |
d2f85f |
, envSlideHasHeader = False
|
|
Packit Service |
d2f85f |
, envInList = False
|
|
Packit Service |
d2f85f |
, envInNoteSlide = False
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data MediaInfo = MediaInfo { mInfoFilePath :: FilePath
|
|
Packit Service |
d2f85f |
, mInfoLocalId :: Int
|
|
Packit Service |
d2f85f |
, mInfoGlobalId :: Int
|
|
Packit Service |
d2f85f |
, mInfoMimeType :: Maybe MimeType
|
|
Packit Service |
d2f85f |
, mInfoExt :: Maybe String
|
|
Packit Service |
d2f85f |
, mInfoCaption :: Bool
|
|
Packit Service |
d2f85f |
} deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data WriterState = WriterState { stCurSlideId :: Int
|
|
Packit Service |
d2f85f |
-- the difference between the number at
|
|
Packit Service |
d2f85f |
-- the end of the slide file name and
|
|
Packit Service |
d2f85f |
-- the rId number
|
|
Packit Service |
d2f85f |
, stSlideIdOffset :: Int
|
|
Packit Service |
d2f85f |
, stLinkIds :: M.Map Int (M.Map Int (URL, String))
|
|
Packit Service |
d2f85f |
-- (FP, Local ID, Global ID, Maybe Mime)
|
|
Packit Service |
d2f85f |
, stMediaIds :: M.Map Int [MediaInfo]
|
|
Packit Service |
d2f85f |
, stMediaGlobalIds :: M.Map FilePath Int
|
|
Packit Service |
d2f85f |
, stNoteIds :: M.Map Int [Block]
|
|
Packit Service |
d2f85f |
} deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
instance Default WriterState where
|
|
Packit Service |
d2f85f |
def = WriterState { stCurSlideId = 0
|
|
Packit Service |
d2f85f |
, stSlideIdOffset = 1
|
|
Packit Service |
d2f85f |
, stLinkIds = mempty
|
|
Packit Service |
d2f85f |
, stMediaIds = mempty
|
|
Packit Service |
d2f85f |
, stMediaGlobalIds = mempty
|
|
Packit Service |
d2f85f |
, stNoteIds = mempty
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
type P m = ReaderT WriterEnv (StateT WriterState m)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
runP :: Monad m => WriterEnv -> WriterState -> P m a -> m a
|
|
Packit Service |
d2f85f |
runP env st p = evalStateT (runReaderT p env) st
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
type Pixels = Integer
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data Presentation = Presentation PresentationSize [Slide]
|
|
Packit Service |
d2f85f |
deriving (Show)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data PresentationSize = PresentationSize { presSizeWidth :: Pixels
|
|
Packit Service |
d2f85f |
, presSizeRatio :: PresentationRatio
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data PresentationRatio = Ratio4x3
|
|
Packit Service |
d2f85f |
| Ratio16x9
|
|
Packit Service |
d2f85f |
| Ratio16x10
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- Note that right now we're only using Ratio4x3.
|
|
Packit Service |
d2f85f |
getPageHeight :: PresentationSize -> Pixels
|
|
Packit Service |
d2f85f |
getPageHeight sz = case presSizeRatio sz of
|
|
Packit Service |
d2f85f |
Ratio4x3 -> floor (((fromInteger (presSizeWidth sz)) / 4) * 3 :: Double)
|
|
Packit Service |
d2f85f |
Ratio16x9 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 9 :: Double)
|
|
Packit Service |
d2f85f |
Ratio16x10 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 10 :: Double)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
instance Default PresentationSize where
|
|
Packit Service |
d2f85f |
def = PresentationSize 720 Ratio4x3
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]
|
|
Packit Service |
d2f85f |
, metadataSlideSubtitle :: [ParaElem]
|
|
Packit Service |
d2f85f |
, metadataSlideAuthors :: [[ParaElem]]
|
|
Packit Service |
d2f85f |
, metadataSlideDate :: [ParaElem]
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
| TitleSlide { titleSlideHeader :: [ParaElem]}
|
|
Packit Service |
d2f85f |
| ContentSlide { contentSlideHeader :: [ParaElem]
|
|
Packit Service |
d2f85f |
, contentSlideContent :: [Shape]
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data SlideElement = SlideElement Pixels Pixels Pixels Pixels Shape
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data Shape = Pic FilePath Text.Pandoc.Definition.Attr [ParaElem]
|
|
Packit Service |
d2f85f |
| GraphicFrame [Graphic] [ParaElem]
|
|
Packit Service |
d2f85f |
| TextBox [Paragraph]
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
type Cell = [Paragraph]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data TableProps = TableProps { tblPrFirstRow :: Bool
|
|
Packit Service |
d2f85f |
, tblPrBandRow :: Bool
|
|
Packit Service |
d2f85f |
} deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
type ColWidth = Integer
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data Graphic = Tbl TableProps [ColWidth] [Cell] [[Cell]]
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data Paragraph = Paragraph { paraProps :: ParaProps
|
|
Packit Service |
d2f85f |
, paraElems :: [ParaElem]
|
|
Packit Service |
d2f85f |
} deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data HeaderType = TitleHeader | SlideHeader | InternalHeader Int
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- type StartingAt = Int
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- data AutoNumType = ArabicNum
|
|
Packit Service |
d2f85f |
-- | AlphaUpperNum
|
|
Packit Service |
d2f85f |
-- | AlphaLowerNum
|
|
Packit Service |
d2f85f |
-- | RomanUpperNum
|
|
Packit Service |
d2f85f |
-- | RomanLowerNum
|
|
Packit Service |
d2f85f |
-- deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- data AutoNumDelim = PeriodDelim
|
|
Packit Service |
d2f85f |
-- | OneParenDelim
|
|
Packit Service |
d2f85f |
-- | TwoParensDelim
|
|
Packit Service |
d2f85f |
-- deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
autoNumberingToType :: ListAttributes -> String
|
|
Packit Service |
d2f85f |
autoNumberingToType (_, numStyle, numDelim) =
|
|
Packit Service |
d2f85f |
typeString ++ delimString
|
|
Packit Service |
d2f85f |
where
|
|
Packit Service |
d2f85f |
typeString = case numStyle of
|
|
Packit Service |
d2f85f |
Decimal -> "arabic"
|
|
Packit Service |
d2f85f |
UpperAlpha -> "alphaUc"
|
|
Packit Service |
d2f85f |
LowerAlpha -> "alphaLc"
|
|
Packit Service |
d2f85f |
UpperRoman -> "romanUc"
|
|
Packit Service |
d2f85f |
LowerRoman -> "romanLc"
|
|
Packit Service |
d2f85f |
_ -> "arabic"
|
|
Packit Service |
d2f85f |
delimString = case numDelim of
|
|
Packit Service |
d2f85f |
Period -> "Period"
|
|
Packit Service |
d2f85f |
OneParen -> "ParenR"
|
|
Packit Service |
d2f85f |
TwoParens -> "ParenBoth"
|
|
Packit Service |
d2f85f |
_ -> "Period"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data BulletType = Bullet
|
|
Packit Service |
d2f85f |
| AutoNumbering ListAttributes
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data Algnment = AlgnLeft | AlgnRight | AlgnCenter
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data ParaProps = ParaProps { pPropHeaderType :: Maybe HeaderType
|
|
Packit Service |
d2f85f |
, pPropMarginLeft :: Maybe Pixels
|
|
Packit Service |
d2f85f |
, pPropMarginRight :: Maybe Pixels
|
|
Packit Service |
d2f85f |
, pPropLevel :: Int
|
|
Packit Service |
d2f85f |
, pPropBullet :: Maybe BulletType
|
|
Packit Service |
d2f85f |
, pPropAlign :: Maybe Algnment
|
|
Packit Service |
d2f85f |
} deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
instance Default ParaProps where
|
|
Packit Service |
d2f85f |
def = ParaProps { pPropHeaderType = Nothing
|
|
Packit Service |
d2f85f |
, pPropMarginLeft = Just 0
|
|
Packit Service |
d2f85f |
, pPropMarginRight = Just 0
|
|
Packit Service |
d2f85f |
, pPropLevel = 0
|
|
Packit Service |
d2f85f |
, pPropBullet = Nothing
|
|
Packit Service |
d2f85f |
, pPropAlign = Nothing
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
newtype TeXString = TeXString {unTeXString :: String}
|
|
Packit Service |
d2f85f |
deriving (Eq, Show)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data ParaElem = Break
|
|
Packit Service |
d2f85f |
| Run RunProps String
|
|
Packit Service |
d2f85f |
-- It would be more elegant to have native TeXMath
|
|
Packit Service |
d2f85f |
-- Expressions here, but this allows us to use
|
|
Packit Service |
d2f85f |
-- `convertmath` from T.P.Writers.Math. Will perhaps
|
|
Packit Service |
d2f85f |
-- revisit in the future.
|
|
Packit Service |
d2f85f |
| MathElem MathType TeXString
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data Strikethrough = NoStrike | SingleStrike | DoubleStrike
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data Capitals = NoCapitals | SmallCapitals | AllCapitals
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
type URL = String
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data RunProps = RunProps { rPropBold :: Bool
|
|
Packit Service |
d2f85f |
, rPropItalics :: Bool
|
|
Packit Service |
d2f85f |
, rStrikethrough :: Maybe Strikethrough
|
|
Packit Service |
d2f85f |
, rBaseline :: Maybe Int
|
|
Packit Service |
d2f85f |
, rCap :: Maybe Capitals
|
|
Packit Service |
d2f85f |
, rLink :: Maybe (URL, String)
|
|
Packit Service |
d2f85f |
, rPropCode :: Bool
|
|
Packit Service |
d2f85f |
, rPropBlockQuote :: Bool
|
|
Packit Service |
d2f85f |
, rPropForceSize :: Maybe Pixels
|
|
Packit Service |
d2f85f |
} deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
instance Default RunProps where
|
|
Packit Service |
d2f85f |
def = RunProps { rPropBold = False
|
|
Packit Service |
d2f85f |
, rPropItalics = False
|
|
Packit Service |
d2f85f |
, rStrikethrough = Nothing
|
|
Packit Service |
d2f85f |
, rBaseline = Nothing
|
|
Packit Service |
d2f85f |
, rCap = Nothing
|
|
Packit Service |
d2f85f |
, rLink = Nothing
|
|
Packit Service |
d2f85f |
, rPropCode = False
|
|
Packit Service |
d2f85f |
, rPropBlockQuote = False
|
|
Packit Service |
d2f85f |
, rPropForceSize = Nothing
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
--------------------------------------------------
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
inlinesToParElems :: Monad m => [Inline] -> P m [ParaElem]
|
|
Packit Service |
d2f85f |
inlinesToParElems ils = concatMapM inlineToParElems ils
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
inlineToParElems :: Monad m => Inline -> P m [ParaElem]
|
|
Packit Service |
d2f85f |
inlineToParElems (Str s) = do
|
|
Packit Service |
d2f85f |
pr <- asks envRunProps
|
|
Packit Service |
d2f85f |
return [Run pr s]
|
|
Packit Service |
d2f85f |
inlineToParElems (Emph ils) =
|
|
Packit Service |
d2f85f |
local (\r -> r{envRunProps = (envRunProps r){rPropItalics=True}}) $
|
|
Packit Service |
d2f85f |
inlinesToParElems ils
|
|
Packit Service |
d2f85f |
inlineToParElems (Strong ils) =
|
|
Packit Service |
d2f85f |
local (\r -> r{envRunProps = (envRunProps r){rPropBold=True}}) $
|
|
Packit Service |
d2f85f |
inlinesToParElems ils
|
|
Packit Service |
d2f85f |
inlineToParElems (Strikeout ils) =
|
|
Packit Service |
d2f85f |
local (\r -> r{envRunProps = (envRunProps r){rStrikethrough=Just SingleStrike}}) $
|
|
Packit Service |
d2f85f |
inlinesToParElems ils
|
|
Packit Service |
d2f85f |
inlineToParElems (Superscript ils) =
|
|
Packit Service |
d2f85f |
local (\r -> r{envRunProps = (envRunProps r){rBaseline=Just 30000}}) $
|
|
Packit Service |
d2f85f |
inlinesToParElems ils
|
|
Packit Service |
d2f85f |
inlineToParElems (Subscript ils) =
|
|
Packit Service |
d2f85f |
local (\r -> r{envRunProps = (envRunProps r){rBaseline=Just (-25000)}}) $
|
|
Packit Service |
d2f85f |
inlinesToParElems ils
|
|
Packit Service |
d2f85f |
inlineToParElems (SmallCaps ils) =
|
|
Packit Service |
d2f85f |
local (\r -> r{envRunProps = (envRunProps r){rCap = Just SmallCapitals}}) $
|
|
Packit Service |
d2f85f |
inlinesToParElems ils
|
|
Packit Service |
d2f85f |
inlineToParElems Space = inlineToParElems (Str " ")
|
|
Packit Service |
d2f85f |
inlineToParElems SoftBreak = inlineToParElems (Str " ")
|
|
Packit Service |
d2f85f |
inlineToParElems LineBreak = return [Break]
|
|
Packit Service |
d2f85f |
inlineToParElems (Link _ ils (url, title)) = do
|
|
Packit Service |
d2f85f |
local (\r ->r{envRunProps = (envRunProps r){rLink = Just (url, title)}}) $
|
|
Packit Service |
d2f85f |
inlinesToParElems ils
|
|
Packit Service |
d2f85f |
inlineToParElems (Code _ str) = do
|
|
Packit Service |
d2f85f |
local (\r ->r{envRunProps = def{rPropCode = True}}) $
|
|
Packit Service |
d2f85f |
inlineToParElems $ Str str
|
|
Packit Service |
d2f85f |
inlineToParElems (Math mathtype str) =
|
|
Packit Service |
d2f85f |
return [MathElem mathtype (TeXString str)]
|
|
Packit Service |
d2f85f |
inlineToParElems (Note blks) = do
|
|
Packit Service |
d2f85f |
notes <- gets stNoteIds
|
|
Packit Service |
d2f85f |
let maxNoteId = case M.keys notes of
|
|
Packit Service |
d2f85f |
[] -> 0
|
|
Packit Service |
d2f85f |
lst -> maximum lst
|
|
Packit Service |
d2f85f |
curNoteId = maxNoteId + 1
|
|
Packit Service |
d2f85f |
modify $ \st -> st { stNoteIds = M.insert curNoteId blks notes }
|
|
Packit Service |
d2f85f |
inlineToParElems $ Superscript [Str $ show curNoteId]
|
|
Packit Service |
d2f85f |
inlineToParElems (Span _ ils) = concatMapM inlineToParElems ils
|
|
Packit Service |
d2f85f |
inlineToParElems (RawInline _ _) = return []
|
|
Packit Service |
d2f85f |
inlineToParElems _ = return []
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
isListType :: Block -> Bool
|
|
Packit Service |
d2f85f |
isListType (OrderedList _ _) = True
|
|
Packit Service |
d2f85f |
isListType (BulletList _) = True
|
|
Packit Service |
d2f85f |
isListType (DefinitionList _) = True
|
|
Packit Service |
d2f85f |
isListType _ = False
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
blockToParagraphs :: PandocMonad m => Block -> P m [Paragraph]
|
|
Packit Service |
d2f85f |
blockToParagraphs (Plain ils) = do
|
|
Packit Service |
d2f85f |
parElems <- inlinesToParElems ils
|
|
Packit Service |
d2f85f |
pProps <- asks envParaProps
|
|
Packit Service |
d2f85f |
return [Paragraph pProps parElems]
|
|
Packit Service |
d2f85f |
blockToParagraphs (Para ils) = do
|
|
Packit Service |
d2f85f |
parElems <- inlinesToParElems ils
|
|
Packit Service |
d2f85f |
pProps <- asks envParaProps
|
|
Packit Service |
d2f85f |
return [Paragraph pProps parElems]
|
|
Packit Service |
d2f85f |
blockToParagraphs (LineBlock ilsList) = do
|
|
Packit Service |
d2f85f |
parElems <- inlinesToParElems $ intercalate [LineBreak] ilsList
|
|
Packit Service |
d2f85f |
pProps <- asks envParaProps
|
|
Packit Service |
d2f85f |
return [Paragraph pProps parElems]
|
|
Packit Service |
d2f85f |
-- TODO: work out the attributes
|
|
Packit Service |
d2f85f |
blockToParagraphs (CodeBlock attr str) =
|
|
Packit Service |
d2f85f |
local (\r -> r{envParaProps = def{pPropMarginLeft = Just 100}}) $
|
|
Packit Service |
d2f85f |
blockToParagraphs $ Para [Code attr str]
|
|
Packit Service |
d2f85f |
-- We can't yet do incremental lists, but we should render a
|
|
Packit Service |
d2f85f |
-- (BlockQuote List) as a list to maintain compatibility with other
|
|
Packit Service |
d2f85f |
-- formats.
|
|
Packit Service |
d2f85f |
blockToParagraphs (BlockQuote (blk : blks)) | isListType blk = do
|
|
Packit Service |
d2f85f |
ps <- blockToParagraphs blk
|
|
Packit Service |
d2f85f |
ps' <- blockToParagraphs $ BlockQuote blks
|
|
Packit Service |
d2f85f |
return $ ps ++ ps'
|
|
Packit Service |
d2f85f |
blockToParagraphs (BlockQuote blks) =
|
|
Packit Service |
d2f85f |
local (\r -> r{ envParaProps = (envParaProps r){pPropMarginLeft = Just 100}
|
|
Packit Service |
d2f85f |
, envRunProps = (envRunProps r){rPropForceSize = Just blockQuoteSize}})$
|
|
Packit Service |
d2f85f |
concatMapM blockToParagraphs blks
|
|
Packit Service |
d2f85f |
-- TODO: work out the format
|
|
Packit Service |
d2f85f |
blockToParagraphs (RawBlock _ _) = return []
|
|
Packit Service |
d2f85f |
-- parElems <- inlinesToParElems [Str str]
|
|
Packit Service |
d2f85f |
-- paraProps <- asks envParaProps
|
|
Packit Service |
d2f85f |
-- return [Paragraph paraProps parElems]
|
|
Packit Service |
d2f85f |
-- TODO: work out the format
|
|
Packit Service |
d2f85f |
blockToParagraphs (Header n _ ils) = do
|
|
Packit Service |
d2f85f |
slideLevel <- asks envSlideLevel
|
|
Packit Service |
d2f85f |
parElems <- inlinesToParElems ils
|
|
Packit Service |
d2f85f |
-- For the time being we're not doing headers inside of bullets, but
|
|
Packit Service |
d2f85f |
-- we might change that.
|
|
Packit Service |
d2f85f |
let headerType = case n `compare` slideLevel of
|
|
Packit Service |
d2f85f |
LT -> TitleHeader
|
|
Packit Service |
d2f85f |
EQ -> SlideHeader
|
|
Packit Service |
d2f85f |
GT -> InternalHeader (n - slideLevel)
|
|
Packit Service |
d2f85f |
return [Paragraph def{pPropHeaderType = Just headerType} parElems]
|
|
Packit Service |
d2f85f |
blockToParagraphs (BulletList blksLst) = do
|
|
Packit Service |
d2f85f |
pProps <- asks envParaProps
|
|
Packit Service |
d2f85f |
let lvl = pPropLevel pProps
|
|
Packit Service |
d2f85f |
local (\env -> env{ envInList = True
|
|
Packit Service |
d2f85f |
, envParaProps = pProps{ pPropLevel = lvl + 1
|
|
Packit Service |
d2f85f |
, pPropBullet = Just Bullet
|
|
Packit Service |
d2f85f |
, pPropMarginLeft = Nothing
|
|
Packit Service |
d2f85f |
}}) $
|
|
Packit Service |
d2f85f |
concatMapM multiParBullet blksLst
|
|
Packit Service |
d2f85f |
blockToParagraphs (OrderedList listAttr blksLst) = do
|
|
Packit Service |
d2f85f |
pProps <- asks envParaProps
|
|
Packit Service |
d2f85f |
let lvl = pPropLevel pProps
|
|
Packit Service |
d2f85f |
local (\env -> env{ envInList = True
|
|
Packit Service |
d2f85f |
, envParaProps = pProps{ pPropLevel = lvl + 1
|
|
Packit Service |
d2f85f |
, pPropBullet = Just (AutoNumbering listAttr)
|
|
Packit Service |
d2f85f |
, pPropMarginLeft = Nothing
|
|
Packit Service |
d2f85f |
}}) $
|
|
Packit Service |
d2f85f |
concatMapM multiParBullet blksLst
|
|
Packit Service |
d2f85f |
blockToParagraphs (DefinitionList entries) = do
|
|
Packit Service |
d2f85f |
let go :: PandocMonad m => ([Inline], [[Block]]) -> P m [Paragraph]
|
|
Packit Service |
d2f85f |
go (ils, blksLst) = do
|
|
Packit Service |
d2f85f |
term <-blockToParagraphs $ Para [Strong ils]
|
|
Packit Service |
d2f85f |
-- For now, we'll treat each definition term as a
|
|
Packit Service |
d2f85f |
-- blockquote. We can extend this further later.
|
|
Packit Service |
d2f85f |
definition <- concatMapM (blockToParagraphs . BlockQuote) blksLst
|
|
Packit Service |
d2f85f |
return $ term ++ definition
|
|
Packit Service |
d2f85f |
concatMapM go entries
|
|
Packit Service |
d2f85f |
blockToParagraphs (Div _ blks) = concatMapM blockToParagraphs blks
|
|
Packit Service |
d2f85f |
-- TODO
|
|
Packit Service |
d2f85f |
blockToParagraphs blk = do
|
|
Packit Service |
d2f85f |
P.report $ BlockNotRendered blk
|
|
Packit Service |
d2f85f |
return []
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- Make sure the bullet env gets turned off after the first para.
|
|
Packit Service |
d2f85f |
multiParBullet :: PandocMonad m => [Block] -> P m [Paragraph]
|
|
Packit Service |
d2f85f |
multiParBullet [] = return []
|
|
Packit Service |
d2f85f |
multiParBullet (b:bs) = do
|
|
Packit Service |
d2f85f |
pProps <- asks envParaProps
|
|
Packit Service |
d2f85f |
p <- blockToParagraphs b
|
|
Packit Service |
d2f85f |
ps <- local (\env -> env{envParaProps = pProps{pPropBullet = Nothing}}) $
|
|
Packit Service |
d2f85f |
concatMapM blockToParagraphs bs
|
|
Packit Service |
d2f85f |
return $ p ++ ps
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
cellToParagraphs :: PandocMonad m => Alignment -> TableCell -> P m [Paragraph]
|
|
Packit Service |
d2f85f |
cellToParagraphs algn tblCell = do
|
|
Packit Service |
d2f85f |
paras <- mapM (blockToParagraphs) tblCell
|
|
Packit Service |
d2f85f |
let alignment = case algn of
|
|
Packit Service |
d2f85f |
AlignLeft -> Just AlgnLeft
|
|
Packit Service |
d2f85f |
AlignRight -> Just AlgnRight
|
|
Packit Service |
d2f85f |
AlignCenter -> Just AlgnCenter
|
|
Packit Service |
d2f85f |
AlignDefault -> Nothing
|
|
Packit Service |
d2f85f |
paras' = map (map (\p -> p{paraProps = (paraProps p){pPropAlign = alignment}})) paras
|
|
Packit Service |
d2f85f |
return $ concat paras'
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
rowToParagraphs :: PandocMonad m => [Alignment] -> [TableCell] -> P m [[Paragraph]]
|
|
Packit Service |
d2f85f |
rowToParagraphs algns tblCells = do
|
|
Packit Service |
d2f85f |
-- We have to make sure we have the right number of alignments
|
|
Packit Service |
d2f85f |
let pairs = zip (algns ++ repeat AlignDefault) tblCells
|
|
Packit Service |
d2f85f |
mapM (\(a, tc) -> cellToParagraphs a tc) pairs
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
blockToShape :: PandocMonad m => Block -> P m Shape
|
|
Packit Service |
d2f85f |
blockToShape (Plain (il:_)) | Image attr ils (url, _) <- il =
|
|
Packit Service |
d2f85f |
Pic url attr <$> (inlinesToParElems ils)
|
|
Packit Service |
d2f85f |
blockToShape (Para (il:_)) | Image attr ils (url, _) <- il =
|
|
Packit Service |
d2f85f |
Pic url attr <$> (inlinesToParElems ils)
|
|
Packit Service |
d2f85f |
blockToShape (Table caption algn _ hdrCells rows) = do
|
|
Packit Service |
d2f85f |
caption' <- inlinesToParElems caption
|
|
Packit Service |
d2f85f |
pageWidth <- presSizeWidth <$> asks envPresentationSize
|
|
Packit Service |
d2f85f |
hdrCells' <- rowToParagraphs algn hdrCells
|
|
Packit Service |
d2f85f |
rows' <- mapM (rowToParagraphs algn) rows
|
|
Packit Service |
d2f85f |
let tblPr = if null hdrCells
|
|
Packit Service |
d2f85f |
then TableProps { tblPrFirstRow = False
|
|
Packit Service |
d2f85f |
, tblPrBandRow = True
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
else TableProps { tblPrFirstRow = True
|
|
Packit Service |
d2f85f |
, tblPrBandRow = True
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
colWidths = if null hdrCells
|
|
Packit Service |
d2f85f |
then case rows of
|
|
Packit Service |
d2f85f |
r : _ | not (null r) -> replicate (length r) $
|
|
Packit Service |
d2f85f |
(pageWidth - (2 * hardcodedTableMargin))`div` (toInteger $ length r)
|
|
Packit Service |
d2f85f |
-- satisfy the compiler. This is the same as
|
|
Packit Service |
d2f85f |
-- saying that rows is empty, but the compiler
|
|
Packit Service |
d2f85f |
-- won't understand that `[]` exhausts the
|
|
Packit Service |
d2f85f |
-- alternatives.
|
|
Packit Service |
d2f85f |
_ -> []
|
|
Packit Service |
d2f85f |
else replicate (length hdrCells) $
|
|
Packit Service |
d2f85f |
(pageWidth - (2 * hardcodedTableMargin)) `div` (toInteger $ length hdrCells)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
return $ GraphicFrame [Tbl tblPr colWidths hdrCells' rows'] caption'
|
|
Packit Service |
d2f85f |
blockToShape blk = TextBox <$> blockToParagraphs blk
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
blocksToShapes :: PandocMonad m => [Block] -> P m [Shape]
|
|
Packit Service |
d2f85f |
blocksToShapes blks = combineShapes <$> mapM blockToShape blks
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
splitBlocks' :: Monad m => [Block] -> [[Block]] -> [Block] -> P m [[Block]]
|
|
Packit Service |
d2f85f |
splitBlocks' cur acc [] = return $ acc ++ (if null cur then [] else [cur])
|
|
Packit Service |
d2f85f |
splitBlocks' cur acc (HorizontalRule : blks) =
|
|
Packit Service |
d2f85f |
splitBlocks' [] (acc ++ (if null cur then [] else [cur])) blks
|
|
Packit Service |
d2f85f |
splitBlocks' cur acc (h@(Header n _ _) : blks) = do
|
|
Packit Service |
d2f85f |
slideLevel <- asks envSlideLevel
|
|
Packit Service |
d2f85f |
case compare n slideLevel of
|
|
Packit Service |
d2f85f |
LT -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[h]]) blks
|
|
Packit Service |
d2f85f |
EQ -> splitBlocks' [h] (acc ++ (if null cur then [] else [cur])) blks
|
|
Packit Service |
d2f85f |
GT -> splitBlocks' (cur ++ [h]) acc blks
|
|
Packit Service |
d2f85f |
splitBlocks' cur acc ((Para (img@(Image _ _ _):ils)) : blks) = do
|
|
Packit Service |
d2f85f |
slideLevel <- asks envSlideLevel
|
|
Packit Service |
d2f85f |
case cur of
|
|
Packit Service |
d2f85f |
(Header n _ _) : [] | n == slideLevel ->
|
|
Packit Service |
d2f85f |
splitBlocks' []
|
|
Packit Service |
d2f85f |
(acc ++ [cur ++ [Para [img]]])
|
|
Packit Service |
d2f85f |
(if null ils then blks else (Para ils) : blks)
|
|
Packit Service |
d2f85f |
_ -> splitBlocks' []
|
|
Packit Service |
d2f85f |
(acc ++ (if null cur then [] else [cur]) ++ [[Para [img]]])
|
|
Packit Service |
d2f85f |
(if null ils then blks else (Para ils) : blks)
|
|
Packit Service |
d2f85f |
splitBlocks' cur acc ((Plain (img@(Image _ _ _):ils)) : blks) = do
|
|
Packit Service |
d2f85f |
slideLevel <- asks envSlideLevel
|
|
Packit Service |
d2f85f |
case cur of
|
|
Packit Service |
d2f85f |
(Header n _ _) : [] | n == slideLevel ->
|
|
Packit Service |
d2f85f |
splitBlocks' []
|
|
Packit Service |
d2f85f |
(acc ++ [cur ++ [Para [img]]])
|
|
Packit Service |
d2f85f |
(if null ils then blks else (Plain ils) : blks)
|
|
Packit Service |
d2f85f |
_ -> splitBlocks' []
|
|
Packit Service |
d2f85f |
(acc ++ (if null cur then [] else [cur]) ++ [[Para [img]]])
|
|
Packit Service |
d2f85f |
(if null ils then blks else (Plain ils) : blks)
|
|
Packit Service |
d2f85f |
splitBlocks' cur acc (tbl@(Table _ _ _ _ _) : blks) = do
|
|
Packit Service |
d2f85f |
slideLevel <- asks envSlideLevel
|
|
Packit Service |
d2f85f |
case cur of
|
|
Packit Service |
d2f85f |
(Header n _ _) : [] | n == slideLevel ->
|
|
Packit Service |
d2f85f |
splitBlocks' [] (acc ++ [cur ++ [tbl]]) blks
|
|
Packit Service |
d2f85f |
_ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[tbl]]) blks
|
|
Packit Service |
d2f85f |
splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
splitBlocks :: Monad m => [Block] -> P m [[Block]]
|
|
Packit Service |
d2f85f |
splitBlocks = splitBlocks' [] []
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
blocksToSlide' :: PandocMonad m => Int -> [Block] -> P m Slide
|
|
Packit Service |
d2f85f |
blocksToSlide' lvl ((Header n _ ils) : blks)
|
|
Packit Service |
d2f85f |
| n < lvl = do
|
|
Packit Service |
d2f85f |
hdr <- inlinesToParElems ils
|
|
Packit Service |
d2f85f |
return $ TitleSlide {titleSlideHeader = hdr}
|
|
Packit Service |
d2f85f |
| n == lvl = do
|
|
Packit Service |
d2f85f |
hdr <- inlinesToParElems ils
|
|
Packit Service |
d2f85f |
inNoteSlide <- asks envInNoteSlide
|
|
Packit Service |
d2f85f |
shapes <- if inNoteSlide
|
|
Packit Service |
d2f85f |
then forceFontSize noteSize $ blocksToShapes blks
|
|
Packit Service |
d2f85f |
else blocksToShapes blks
|
|
Packit Service |
d2f85f |
return $ ContentSlide { contentSlideHeader = hdr
|
|
Packit Service |
d2f85f |
, contentSlideContent = shapes
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
blocksToSlide' _ (blk : blks) = do
|
|
Packit Service |
d2f85f |
inNoteSlide <- asks envInNoteSlide
|
|
Packit Service |
d2f85f |
shapes <- if inNoteSlide
|
|
Packit Service |
d2f85f |
then forceFontSize noteSize $ blocksToShapes (blk : blks)
|
|
Packit Service |
d2f85f |
else blocksToShapes (blk : blks)
|
|
Packit Service |
d2f85f |
return $ ContentSlide { contentSlideHeader = []
|
|
Packit Service |
d2f85f |
, contentSlideContent = shapes
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
blocksToSlide' _ [] = return $ ContentSlide { contentSlideHeader = []
|
|
Packit Service |
d2f85f |
, contentSlideContent = []
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
blocksToSlide :: PandocMonad m => [Block] -> P m Slide
|
|
Packit Service |
d2f85f |
blocksToSlide blks = do
|
|
Packit Service |
d2f85f |
slideLevel <- asks envSlideLevel
|
|
Packit Service |
d2f85f |
blocksToSlide' slideLevel blks
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
makeNoteEntry :: Int -> [Block] -> [Block]
|
|
Packit Service |
d2f85f |
makeNoteEntry n blks =
|
|
Packit Service |
d2f85f |
let enum = Str (show n ++ ".")
|
|
Packit Service |
d2f85f |
in
|
|
Packit Service |
d2f85f |
case blks of
|
|
Packit Service |
d2f85f |
(Para ils : blks') -> (Para $ enum : Space : ils) : blks'
|
|
Packit Service |
d2f85f |
_ -> (Para [enum]) : blks
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
forceFontSize :: PandocMonad m => Pixels -> P m a -> P m a
|
|
Packit Service |
d2f85f |
forceFontSize px x = do
|
|
Packit Service |
d2f85f |
rpr <- asks envRunProps
|
|
Packit Service |
d2f85f |
local (\r -> r {envRunProps = rpr{rPropForceSize = Just px}}) x
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- Right now, there's no logic for making more than one slide, but I
|
|
Packit Service |
d2f85f |
-- want to leave the option open to make multiple slides if we figure
|
|
Packit Service |
d2f85f |
-- out how to guess at how much space the text of the notes will take
|
|
Packit Service |
d2f85f |
-- up (or if we allow a way for it to be manually controlled). Plus a
|
|
Packit Service |
d2f85f |
-- list will make it easier to put together in the final
|
|
Packit Service |
d2f85f |
-- `blocksToPresentation` function (since we can just add an empty
|
|
Packit Service |
d2f85f |
-- list without checking the state).
|
|
Packit Service |
d2f85f |
makeNotesSlides :: PandocMonad m => P m [Slide]
|
|
Packit Service |
d2f85f |
makeNotesSlides = local (\env -> env{envInNoteSlide=True}) $ do
|
|
Packit Service |
d2f85f |
noteIds <- gets stNoteIds
|
|
Packit Service |
d2f85f |
if M.null noteIds
|
|
Packit Service |
d2f85f |
then return []
|
|
Packit Service |
d2f85f |
else do let hdr = Header 2 nullAttr [Str "Notes"]
|
|
Packit Service |
d2f85f |
blks <- return $
|
|
Packit Service |
d2f85f |
concatMap (\(n, bs) -> makeNoteEntry n bs) $
|
|
Packit Service |
d2f85f |
M.toList noteIds
|
|
Packit Service |
d2f85f |
sld <- blocksToSlide $ hdr : blks
|
|
Packit Service |
d2f85f |
return [sld]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
getMetaSlide :: PandocMonad m => P m (Maybe Slide)
|
|
Packit Service |
d2f85f |
getMetaSlide = do
|
|
Packit Service |
d2f85f |
meta <- asks envMetadata
|
|
Packit Service |
d2f85f |
title <- inlinesToParElems $ docTitle meta
|
|
Packit Service |
d2f85f |
subtitle <- inlinesToParElems $
|
|
Packit Service |
d2f85f |
case lookupMeta "subtitle" meta of
|
|
Packit Service |
d2f85f |
Just (MetaString s) -> [Str s]
|
|
Packit Service |
d2f85f |
Just (MetaInlines ils) -> ils
|
|
Packit Service |
d2f85f |
Just (MetaBlocks [Plain ils]) -> ils
|
|
Packit Service |
d2f85f |
Just (MetaBlocks [Para ils]) -> ils
|
|
Packit Service |
d2f85f |
_ -> []
|
|
Packit Service |
d2f85f |
authors <- mapM inlinesToParElems $ docAuthors meta
|
|
Packit Service |
d2f85f |
date <- inlinesToParElems $ docDate meta
|
|
Packit Service |
d2f85f |
if null title && null subtitle && null authors && null date
|
|
Packit Service |
d2f85f |
then return Nothing
|
|
Packit Service |
d2f85f |
else return $ Just $ MetadataSlide { metadataSlideTitle = title
|
|
Packit Service |
d2f85f |
, metadataSlideSubtitle = subtitle
|
|
Packit Service |
d2f85f |
, metadataSlideAuthors = authors
|
|
Packit Service |
d2f85f |
, metadataSlideDate = date
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
blocksToPresentation :: PandocMonad m => [Block] -> P m Presentation
|
|
Packit Service |
d2f85f |
blocksToPresentation blks = do
|
|
Packit Service |
d2f85f |
blksLst <- splitBlocks blks
|
|
Packit Service |
d2f85f |
slides <- mapM blocksToSlide blksLst
|
|
Packit Service |
d2f85f |
noteSlides <- makeNotesSlides
|
|
Packit Service |
d2f85f |
let slides' = slides ++ noteSlides
|
|
Packit Service |
d2f85f |
metadataslide <- getMetaSlide
|
|
Packit Service |
d2f85f |
presSize <- asks envPresentationSize
|
|
Packit Service |
d2f85f |
return $ case metadataslide of
|
|
Packit Service |
d2f85f |
Just metadataslide' -> Presentation presSize $ metadataslide' : slides'
|
|
Packit Service |
d2f85f |
Nothing -> Presentation presSize slides'
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
--------------------------------------------------------------------
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
copyFileToArchive :: PandocMonad m => Archive -> FilePath -> P m Archive
|
|
Packit Service |
d2f85f |
copyFileToArchive arch fp = do
|
|
Packit Service |
d2f85f |
refArchive <- asks envRefArchive
|
|
Packit Service |
d2f85f |
distArchive <- asks envDistArchive
|
|
Packit Service |
d2f85f |
case findEntryByPath fp refArchive `mplus` findEntryByPath fp distArchive of
|
|
Packit Service |
d2f85f |
Nothing -> fail $ fp ++ " missing in reference file"
|
|
Packit Service |
d2f85f |
Just e -> return $ addEntryToArchive e arch
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
getMediaFiles :: PandocMonad m => P m [FilePath]
|
|
Packit Service |
d2f85f |
getMediaFiles = do
|
|
Packit Service |
d2f85f |
refArchive <- asks envRefArchive
|
|
Packit Service |
d2f85f |
distArchive <- asks envDistArchive
|
|
Packit Service |
d2f85f |
let allEntries = nub $ filesInArchive refArchive ++ filesInArchive distArchive
|
|
Packit Service |
d2f85f |
return $ filter (isPrefixOf "ppt/media") allEntries
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
copyFileToArchiveIfExists :: PandocMonad m => Archive -> FilePath -> P m Archive
|
|
Packit Service |
d2f85f |
copyFileToArchiveIfExists arch fp = do
|
|
Packit Service |
d2f85f |
refArchive <- asks envRefArchive
|
|
Packit Service |
d2f85f |
distArchive <- asks envDistArchive
|
|
Packit Service |
d2f85f |
case findEntryByPath fp refArchive `mplus` findEntryByPath fp distArchive of
|
|
Packit Service |
d2f85f |
Nothing -> return $ arch
|
|
Packit Service |
d2f85f |
Just e -> return $ addEntryToArchive e arch
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
inheritedFiles :: [FilePath]
|
|
Packit Service |
d2f85f |
inheritedFiles = [ "_rels/.rels"
|
|
Packit Service |
d2f85f |
, "docProps/app.xml"
|
|
Packit Service |
d2f85f |
, "docProps/core.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout4.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout9.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout2.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout10.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout1.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout3.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout5.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout7.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout8.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout11.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout4.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/_rels/slideLayout6.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout2.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout8.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout11.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout3.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout6.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout9.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout5.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout7.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout1.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideLayouts/slideLayout10.xml"
|
|
Packit Service |
d2f85f |
-- , "ppt/_rels/presentation.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/theme/theme1.xml"
|
|
Packit Service |
d2f85f |
, "ppt/presProps.xml"
|
|
Packit Service |
d2f85f |
-- , "ppt/slides/_rels/slide1.xml.rels"
|
|
Packit Service |
d2f85f |
-- , "ppt/slides/_rels/slide2.xml.rels"
|
|
Packit Service |
d2f85f |
-- This is the one we're
|
|
Packit Service |
d2f85f |
-- going to build
|
|
Packit Service |
d2f85f |
-- , "ppt/slides/slide2.xml"
|
|
Packit Service |
d2f85f |
-- , "ppt/slides/slide1.xml"
|
|
Packit Service |
d2f85f |
, "ppt/viewProps.xml"
|
|
Packit Service |
d2f85f |
, "ppt/tableStyles.xml"
|
|
Packit Service |
d2f85f |
, "ppt/slideMasters/_rels/slideMaster1.xml.rels"
|
|
Packit Service |
d2f85f |
, "ppt/slideMasters/slideMaster1.xml"
|
|
Packit Service |
d2f85f |
-- , "ppt/presentation.xml"
|
|
Packit Service |
d2f85f |
-- , "[Content_Types].xml"
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- Here are some that might not be there. We won't fail if they're not
|
|
Packit Service |
d2f85f |
possibleInheritedFiles :: [FilePath]
|
|
Packit Service |
d2f85f |
possibleInheritedFiles = [ "ppt/theme/_rels/theme1.xml.rels" ]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
presentationToArchive :: PandocMonad m => Presentation -> P m Archive
|
|
Packit Service |
d2f85f |
presentationToArchive p@(Presentation _ slides) = do
|
|
Packit Service |
d2f85f |
newArch <- foldM copyFileToArchive emptyArchive inheritedFiles
|
|
Packit Service |
d2f85f |
mediaDir <- getMediaFiles
|
|
Packit Service |
d2f85f |
newArch' <- foldM copyFileToArchiveIfExists newArch $
|
|
Packit Service |
d2f85f |
possibleInheritedFiles ++ mediaDir
|
|
Packit Service |
d2f85f |
-- presentation entry and rels. We have to do the rels first to make
|
|
Packit Service |
d2f85f |
-- sure we know the correct offset for the rIds.
|
|
Packit Service |
d2f85f |
presEntry <- presentationToPresEntry p
|
|
Packit Service |
d2f85f |
presRelsEntry <- presentationToRelsEntry p
|
|
Packit Service |
d2f85f |
slideEntries <- mapM (\(s, n) -> slideToEntry s n) $ zip slides [1..]
|
|
Packit Service |
d2f85f |
slideRelEntries <- mapM (\(s,n) -> slideToSlideRelEntry s n) $ zip slides [1..]
|
|
Packit Service |
d2f85f |
-- These have to come after everything, because they need the info
|
|
Packit Service |
d2f85f |
-- built up in the state.
|
|
Packit Service |
d2f85f |
mediaEntries <- makeMediaEntries
|
|
Packit Service |
d2f85f |
contentTypesEntry <- presentationToContentTypes p >>= contentTypesToEntry
|
|
Packit Service |
d2f85f |
-- fold everything into our inherited archive and return it.
|
|
Packit Service |
d2f85f |
return $ foldr addEntryToArchive newArch' $
|
|
Packit Service |
d2f85f |
slideEntries ++
|
|
Packit Service |
d2f85f |
slideRelEntries ++
|
|
Packit Service |
d2f85f |
mediaEntries ++
|
|
Packit Service |
d2f85f |
[contentTypesEntry, presEntry, presRelsEntry]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
--------------------------------------------------
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
combineShapes :: [Shape] -> [Shape]
|
|
Packit Service |
d2f85f |
combineShapes [] = []
|
|
Packit Service |
d2f85f |
combineShapes (s : []) = [s]
|
|
Packit Service |
d2f85f |
combineShapes (pic@(Pic _ _ _) : ss) = pic : combineShapes ss
|
|
Packit Service |
d2f85f |
combineShapes ((TextBox []) : ss) = combineShapes ss
|
|
Packit Service |
d2f85f |
combineShapes (s : TextBox [] : ss) = combineShapes (s : ss)
|
|
Packit Service |
d2f85f |
combineShapes (s@(TextBox (p:ps)) : s'@(TextBox (p':ps')) : ss)
|
|
Packit Service |
d2f85f |
| pPropHeaderType (paraProps p) == Just TitleHeader ||
|
|
Packit Service |
d2f85f |
pPropHeaderType (paraProps p) == Just SlideHeader =
|
|
Packit Service |
d2f85f |
TextBox [p] : (combineShapes $ TextBox ps : s' : ss)
|
|
Packit Service |
d2f85f |
| pPropHeaderType (paraProps p') == Just TitleHeader ||
|
|
Packit Service |
d2f85f |
pPropHeaderType (paraProps p') == Just SlideHeader =
|
|
Packit Service |
d2f85f |
s : TextBox [p'] : (combineShapes $ TextBox ps' : ss)
|
|
Packit Service |
d2f85f |
| otherwise = combineShapes $ TextBox ((p:ps) ++ (p':ps')) : ss
|
|
Packit Service |
d2f85f |
combineShapes (s:ss) = s : combineShapes ss
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
--------------------------------------------------
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
getLayout :: PandocMonad m => Slide -> P m Element
|
|
Packit Service |
d2f85f |
getLayout slide = do
|
|
Packit Service |
d2f85f |
let layoutpath = case slide of
|
|
Packit Service |
d2f85f |
(MetadataSlide _ _ _ _) -> "ppt/slideLayouts/slideLayout1.xml"
|
|
Packit Service |
d2f85f |
(TitleSlide _) -> "ppt/slideLayouts/slideLayout3.xml"
|
|
Packit Service |
d2f85f |
(ContentSlide _ _) -> "ppt/slideLayouts/slideLayout2.xml"
|
|
Packit Service |
d2f85f |
distArchive <- asks envDistArchive
|
|
Packit Service |
d2f85f |
root <- case findEntryByPath layoutpath distArchive of
|
|
Packit Service |
d2f85f |
Just e -> case parseXMLDoc $ UTF8.toStringLazy $ fromEntry e of
|
|
Packit Service |
d2f85f |
Just element -> return $ element
|
|
Packit Service |
d2f85f |
Nothing -> throwError $
|
|
Packit Service |
d2f85f |
PandocSomeError $
|
|
Packit Service |
d2f85f |
layoutpath ++ " corrupt in reference file"
|
|
Packit Service |
d2f85f |
Nothing -> throwError $
|
|
Packit Service |
d2f85f |
PandocSomeError $
|
|
Packit Service |
d2f85f |
layoutpath ++ " missing in reference file"
|
|
Packit Service |
d2f85f |
return root
|
|
Packit Service |
d2f85f |
-- let ns = elemToNameSpaces root
|
|
Packit Service |
d2f85f |
-- case findChild (elemName ns "p" "cSld") root of
|
|
Packit Service |
d2f85f |
-- Just element' -> return element'
|
|
Packit Service |
d2f85f |
-- Nothing -> throwError $
|
|
Packit Service |
d2f85f |
-- PandocSomeError $
|
|
Packit Service |
d2f85f |
-- layoutpath ++ " not correctly formed layout file"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
shapeHasName :: NameSpaces -> String -> Element -> Bool
|
|
Packit Service |
d2f85f |
shapeHasName ns name element
|
|
Packit Service |
d2f85f |
| Just nvSpPr <- findChild (elemName ns "p" "nvSpPr") element
|
|
Packit Service |
d2f85f |
, Just cNvPr <- findChild (elemName ns "p" "cNvPr") nvSpPr
|
|
Packit Service |
d2f85f |
, Just nm <- findAttr (QName "name" Nothing Nothing) cNvPr =
|
|
Packit Service |
d2f85f |
nm == name
|
|
Packit Service |
d2f85f |
| otherwise = False
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- getContentTitleShape :: NameSpaces -> Element -> Maybe Element
|
|
Packit Service |
d2f85f |
-- getContentTitleShape ns spTreeElem
|
|
Packit Service |
d2f85f |
-- | isElem ns "p" "spTree" spTreeElem =
|
|
Packit Service |
d2f85f |
-- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Title 1" e)) spTreeElem
|
|
Packit Service |
d2f85f |
-- | otherwise = Nothing
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- getSubtitleShape :: NameSpaces -> Element -> Maybe Element
|
|
Packit Service |
d2f85f |
-- getSubtitleShape ns spTreeElem
|
|
Packit Service |
d2f85f |
-- | isElem ns "p" "spTree" spTreeElem =
|
|
Packit Service |
d2f85f |
-- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Subtitle 2" e)) spTreeElem
|
|
Packit Service |
d2f85f |
-- | otherwise = Nothing
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- getDateShape :: NameSpaces -> Element -> Maybe Element
|
|
Packit Service |
d2f85f |
-- getDateShape ns spTreeElem
|
|
Packit Service |
d2f85f |
-- | isElem ns "p" "spTree" spTreeElem =
|
|
Packit Service |
d2f85f |
-- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Date Placeholder 3" e)) spTreeElem
|
|
Packit Service |
d2f85f |
-- | otherwise = Nothing
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
getContentShape :: NameSpaces -> Element -> Maybe Element
|
|
Packit Service |
d2f85f |
getContentShape ns spTreeElem
|
|
Packit Service |
d2f85f |
| isElem ns "p" "spTree" spTreeElem =
|
|
Packit Service |
d2f85f |
filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Content Placeholder 2" e)) spTreeElem
|
|
Packit Service |
d2f85f |
| otherwise = Nothing
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- cursorHasName :: QName -> XMLC.Cursor -> Bool
|
|
Packit Service |
d2f85f |
-- cursorHasName nm cur = case XMLC.current cur of
|
|
Packit Service |
d2f85f |
-- Elem element -> case XMLC.tagName $ XMLC.getTag element of
|
|
Packit Service |
d2f85f |
-- nm -> True
|
|
Packit Service |
d2f85f |
-- _ -> False
|
|
Packit Service |
d2f85f |
-- _ -> False
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- fillInTxBody :: NameSpaces -> [Paragraph] -> Element -> Element
|
|
Packit Service |
d2f85f |
-- fillInTxBody ns paras txBodyElem
|
|
Packit Service |
d2f85f |
-- | isElem ns "p" "txBody" txBodyElem =
|
|
Packit Service |
d2f85f |
-- replaceNamedChildren ns "a" "p" (map paragraphToElement paras) txBodyElem
|
|
Packit Service |
d2f85f |
-- | otherwise = txBodyElem
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- fillInShape :: NameSpaces -> Shape -> Element -> Element
|
|
Packit Service |
d2f85f |
-- fillInShape ns shape spElem
|
|
Packit Service |
d2f85f |
-- | TextBox paras <- shape
|
|
Packit Service |
d2f85f |
-- , isElemn ns "p" "sp" spElem =
|
|
Packit Service |
d2f85f |
-- replaceNamedChildren ns "p" "txBody" (fillInTxBody ns paras sp
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- fillInShape :: NameSpaces -> Element -> Shape -> Element
|
|
Packit Service |
d2f85f |
-- fillInShape ns spElem (TextBox paras) = fillInParagraphs ns spElem paras
|
|
Packit Service |
d2f85f |
-- fillInShape _ spElem pic = spElem
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
contentIsElem :: NameSpaces -> String -> String -> Content -> Bool
|
|
Packit Service |
d2f85f |
contentIsElem ns prefix name (Elem element) = isElem ns prefix name element
|
|
Packit Service |
d2f85f |
contentIsElem _ _ _ _ = False
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
replaceNamedChildren :: NameSpaces -> String -> String -> [Element] -> Element -> Element
|
|
Packit Service |
d2f85f |
replaceNamedChildren ns prefix name newKids element =
|
|
Packit Service |
d2f85f |
let content = elContent element
|
|
Packit Service |
d2f85f |
content' = filter (\c -> not (contentIsElem ns prefix name c)) content
|
|
Packit Service |
d2f85f |
in
|
|
Packit Service |
d2f85f |
element{elContent = content' ++ map Elem newKids}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
----------------------------------------------------------------
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
registerLink :: PandocMonad m => (URL, String) -> P m Int
|
|
Packit Service |
d2f85f |
registerLink link = do
|
|
Packit Service |
d2f85f |
curSlideId <- gets stCurSlideId
|
|
Packit Service |
d2f85f |
linkReg <- gets stLinkIds
|
|
Packit Service |
d2f85f |
mediaReg <- gets stMediaIds
|
|
Packit Service |
d2f85f |
let maxLinkId = case M.lookup curSlideId linkReg of
|
|
Packit Service |
d2f85f |
Just mp -> case M.keys mp of
|
|
Packit Service |
d2f85f |
[] -> 1
|
|
Packit Service |
d2f85f |
ks -> maximum ks
|
|
Packit Service |
d2f85f |
Nothing -> 1
|
|
Packit Service |
d2f85f |
maxMediaId = case M.lookup curSlideId mediaReg of
|
|
Packit Service |
d2f85f |
Just [] -> 1
|
|
Packit Service |
d2f85f |
Just mInfos -> maximum $ map mInfoLocalId mInfos
|
|
Packit Service |
d2f85f |
Nothing -> 1
|
|
Packit Service |
d2f85f |
maxId = max maxLinkId maxMediaId
|
|
Packit Service |
d2f85f |
slideLinks = case M.lookup curSlideId linkReg of
|
|
Packit Service |
d2f85f |
Just mp -> M.insert (maxId + 1) link mp
|
|
Packit Service |
d2f85f |
Nothing -> M.singleton (maxId + 1) link
|
|
Packit Service |
d2f85f |
modify $ \st -> st{ stLinkIds = M.insert curSlideId slideLinks linkReg}
|
|
Packit Service |
d2f85f |
return $ maxId + 1
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
registerMedia :: PandocMonad m => FilePath -> [ParaElem] -> P m MediaInfo
|
|
Packit Service |
d2f85f |
registerMedia fp caption = do
|
|
Packit Service |
d2f85f |
curSlideId <- gets stCurSlideId
|
|
Packit Service |
d2f85f |
linkReg <- gets stLinkIds
|
|
Packit Service |
d2f85f |
mediaReg <- gets stMediaIds
|
|
Packit Service |
d2f85f |
globalIds <- gets stMediaGlobalIds
|
|
Packit Service |
d2f85f |
let maxLinkId = case M.lookup curSlideId linkReg of
|
|
Packit Service |
d2f85f |
Just mp -> case M.keys mp of
|
|
Packit Service |
d2f85f |
[] -> 1
|
|
Packit Service |
d2f85f |
ks -> maximum ks
|
|
Packit Service |
d2f85f |
Nothing -> 1
|
|
Packit Service |
d2f85f |
maxMediaId = case M.lookup curSlideId mediaReg of
|
|
Packit Service |
d2f85f |
Just [] -> 1
|
|
Packit Service |
d2f85f |
Just mInfos -> maximum $ map mInfoLocalId mInfos
|
|
Packit Service |
d2f85f |
Nothing -> 1
|
|
Packit Service |
d2f85f |
maxLocalId = max maxLinkId maxMediaId
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
maxGlobalId = case M.elems globalIds of
|
|
Packit Service |
d2f85f |
[] -> 0
|
|
Packit Service |
d2f85f |
ids -> maximum ids
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
(imgBytes, mbMt) <- P.fetchItem fp
|
|
Packit Service |
d2f85f |
let imgExt = (mbMt >>= extensionFromMimeType >>= (\x -> return $ '.':x))
|
|
Packit Service |
d2f85f |
<|>
|
|
Packit Service |
d2f85f |
case imageType imgBytes of
|
|
Packit Service |
d2f85f |
Just Png -> Just ".png"
|
|
Packit Service |
d2f85f |
Just Jpeg -> Just ".jpeg"
|
|
Packit Service |
d2f85f |
Just Gif -> Just ".gif"
|
|
Packit Service |
d2f85f |
Just Pdf -> Just ".pdf"
|
|
Packit Service |
d2f85f |
Just Eps -> Just ".eps"
|
|
Packit Service |
d2f85f |
Just Svg -> Just ".svg"
|
|
Packit Service |
d2f85f |
Nothing -> Nothing
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let newGlobalId = case M.lookup fp globalIds of
|
|
Packit Service |
d2f85f |
Just ident -> ident
|
|
Packit Service |
d2f85f |
Nothing -> maxGlobalId + 1
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let newGlobalIds = M.insert fp newGlobalId globalIds
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let mediaInfo = MediaInfo { mInfoFilePath = fp
|
|
Packit Service |
d2f85f |
, mInfoLocalId = maxLocalId + 1
|
|
Packit Service |
d2f85f |
, mInfoGlobalId = newGlobalId
|
|
Packit Service |
d2f85f |
, mInfoMimeType = mbMt
|
|
Packit Service |
d2f85f |
, mInfoExt = imgExt
|
|
Packit Service |
d2f85f |
, mInfoCaption = (not . null) caption
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let slideMediaInfos = case M.lookup curSlideId mediaReg of
|
|
Packit Service |
d2f85f |
Just minfos -> mediaInfo : minfos
|
|
Packit Service |
d2f85f |
Nothing -> [mediaInfo]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
modify $ \st -> st{ stMediaIds = M.insert curSlideId slideMediaInfos mediaReg
|
|
Packit Service |
d2f85f |
, stMediaGlobalIds = newGlobalIds
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
return mediaInfo
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
makeMediaEntry :: PandocMonad m => MediaInfo -> P m Entry
|
|
Packit Service |
d2f85f |
makeMediaEntry mInfo = do
|
|
Packit Service |
d2f85f |
epochtime <- (floor . utcTimeToPOSIXSeconds) <$> asks envUTCTime
|
|
Packit Service |
d2f85f |
(imgBytes, _) <- P.fetchItem (mInfoFilePath mInfo)
|
|
Packit Service |
d2f85f |
let ext = case mInfoExt mInfo of
|
|
Packit Service |
d2f85f |
Just e -> e
|
|
Packit Service |
d2f85f |
Nothing -> ""
|
|
Packit Service |
d2f85f |
let fp = "ppt/media/image" ++ (show $ mInfoGlobalId mInfo) ++ ext
|
|
Packit Service |
d2f85f |
return $ toEntry fp epochtime $ BL.fromStrict imgBytes
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
makeMediaEntries :: PandocMonad m => P m [Entry]
|
|
Packit Service |
d2f85f |
makeMediaEntries = do
|
|
Packit Service |
d2f85f |
mediaInfos <- gets stMediaIds
|
|
Packit Service |
d2f85f |
let allInfos = mconcat $ M.elems mediaInfos
|
|
Packit Service |
d2f85f |
mapM makeMediaEntry allInfos
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- | Scales the image to fit the page
|
|
Packit Service |
d2f85f |
-- sizes are passed in emu
|
|
Packit Service |
d2f85f |
fitToPage' :: (Double, Double) -- image size in emu
|
|
Packit Service |
d2f85f |
-> Integer -- pageWidth
|
|
Packit Service |
d2f85f |
-> Integer -- pageHeight
|
|
Packit Service |
d2f85f |
-> (Integer, Integer) -- imagesize
|
|
Packit Service |
d2f85f |
fitToPage' (x, y) pageWidth pageHeight
|
|
Packit Service |
d2f85f |
-- Fixes width to the page width and scales the height
|
|
Packit Service |
d2f85f |
| x <= fromIntegral pageWidth && y <= fromIntegral pageHeight =
|
|
Packit Service |
d2f85f |
(floor x, floor y)
|
|
Packit Service |
d2f85f |
| x / fromIntegral pageWidth > y / fromIntegral pageWidth =
|
|
Packit Service |
d2f85f |
(pageWidth, floor $ ((fromIntegral pageWidth) / x) * y)
|
|
Packit Service |
d2f85f |
| otherwise =
|
|
Packit Service |
d2f85f |
(floor $ ((fromIntegral pageHeight) / y) * x, pageHeight)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
positionImage :: (Double, Double) -> Integer -> Integer -> (Integer, Integer)
|
|
Packit Service |
d2f85f |
positionImage (x, y) pageWidth pageHeight =
|
|
Packit Service |
d2f85f |
let (x', y') = fitToPage' (x, y) pageWidth pageHeight
|
|
Packit Service |
d2f85f |
in
|
|
Packit Service |
d2f85f |
((pageWidth - x') `div` 2, (pageHeight - y') `div` 2)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
getMaster :: PandocMonad m => P m Element
|
|
Packit Service |
d2f85f |
getMaster = do
|
|
Packit Service |
d2f85f |
refArchive <- asks envRefArchive
|
|
Packit Service |
d2f85f |
distArchive <- asks envDistArchive
|
|
Packit Service |
d2f85f |
parseXml refArchive distArchive "ppt/slideMasters/slideMaster1.xml"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- We want to get the header dimensions, so we can make sure that the
|
|
Packit Service |
d2f85f |
-- image goes underneath it. We only use this in a content slide if it
|
|
Packit Service |
d2f85f |
-- has a header.
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
getHeaderSize :: PandocMonad m => P m ((Integer, Integer), (Integer, Integer))
|
|
Packit Service |
d2f85f |
getHeaderSize = do
|
|
Packit Service |
d2f85f |
master <- getMaster
|
|
Packit Service |
d2f85f |
let ns = elemToNameSpaces master
|
|
Packit Service |
d2f85f |
sps = [master] >>=
|
|
Packit Service |
d2f85f |
findChildren (elemName ns "p" "cSld") >>=
|
|
Packit Service |
d2f85f |
findChildren (elemName ns "p" "spTree") >>=
|
|
Packit Service |
d2f85f |
findChildren (elemName ns "p" "sp")
|
|
Packit Service |
d2f85f |
mbXfrm =
|
|
Packit Service |
d2f85f |
listToMaybe (filter (shapeHasName ns "Title Placeholder 1") sps) >>=
|
|
Packit Service |
d2f85f |
findChild (elemName ns "p" "spPr") >>=
|
|
Packit Service |
d2f85f |
findChild (elemName ns "a" "xfrm")
|
|
Packit Service |
d2f85f |
xoff = mbXfrm >>=
|
|
Packit Service |
d2f85f |
findChild (elemName ns "a" "off") >>=
|
|
Packit Service |
d2f85f |
findAttr (QName "x" Nothing Nothing) >>=
|
|
Packit Service |
d2f85f |
(listToMaybe . (\s -> reads s :: [(Integer, String)]))
|
|
Packit Service |
d2f85f |
yoff = mbXfrm >>=
|
|
Packit Service |
d2f85f |
findChild (elemName ns "a" "off") >>=
|
|
Packit Service |
d2f85f |
findAttr (QName "y" Nothing Nothing) >>=
|
|
Packit Service |
d2f85f |
(listToMaybe . (\s -> reads s :: [(Integer, String)]))
|
|
Packit Service |
d2f85f |
xext = mbXfrm >>=
|
|
Packit Service |
d2f85f |
findChild (elemName ns "a" "ext") >>=
|
|
Packit Service |
d2f85f |
findAttr (QName "cx" Nothing Nothing) >>=
|
|
Packit Service |
d2f85f |
(listToMaybe . (\s -> reads s :: [(Integer, String)]))
|
|
Packit Service |
d2f85f |
yext = mbXfrm >>=
|
|
Packit Service |
d2f85f |
findChild (elemName ns "a" "ext") >>=
|
|
Packit Service |
d2f85f |
findAttr (QName "cy" Nothing Nothing) >>=
|
|
Packit Service |
d2f85f |
(listToMaybe . (\s -> reads s :: [(Integer, String)]))
|
|
Packit Service |
d2f85f |
off = case xoff of
|
|
Packit Service |
d2f85f |
Just (xoff', _) | Just (yoff',_) <- yoff -> (xoff', yoff')
|
|
Packit Service |
d2f85f |
_ -> (1043490, 1027664)
|
|
Packit Service |
d2f85f |
ext = case xext of
|
|
Packit Service |
d2f85f |
Just (xext', _) | Just (yext',_) <- yext -> (xext', yext')
|
|
Packit Service |
d2f85f |
_ -> (7024744, 1143000)
|
|
Packit Service |
d2f85f |
return $ (off, ext)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- Hard-coded for now
|
|
Packit Service |
d2f85f |
captionPosition :: ((Integer, Integer), (Integer, Integer))
|
|
Packit Service |
d2f85f |
captionPosition = ((457200, 6061972), (8229600, 527087))
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
createCaption :: PandocMonad m => [ParaElem] -> P m Element
|
|
Packit Service |
d2f85f |
createCaption paraElements = do
|
|
Packit Service |
d2f85f |
let para = Paragraph def{pPropAlign = Just AlgnCenter} paraElements
|
|
Packit Service |
d2f85f |
elements <- mapM paragraphToElement [para]
|
|
Packit Service |
d2f85f |
let ((x, y), (cx, cy)) = captionPosition
|
|
Packit Service |
d2f85f |
let txBody = mknode "p:txBody" [] $
|
|
Packit Service |
d2f85f |
[mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ elements
|
|
Packit Service |
d2f85f |
return $
|
|
Packit Service |
d2f85f |
mknode "p:sp" [] [ mknode "p:nvSpPr" []
|
|
Packit Service |
d2f85f |
[ mknode "p:cNvPr" [("id","1"), ("name","TextBox 3")] ()
|
|
Packit Service |
d2f85f |
, mknode "p:cNvSpPr" [("txBox", "1")] ()
|
|
Packit Service |
d2f85f |
, mknode "p:nvPr" [] ()
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
, mknode "p:spPr" []
|
|
Packit Service |
d2f85f |
[ mknode "a:xfrm" []
|
|
Packit Service |
d2f85f |
[ mknode "a:off" [("x", show x), ("y", show y)] ()
|
|
Packit Service |
d2f85f |
, mknode "a:ext" [("cx", show cx), ("cy", show cy)] ()
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
, mknode "a:prstGeom" [("prst", "rect")]
|
|
Packit Service |
d2f85f |
[ mknode "a:avLst" [] ()
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
, mknode "a:noFill" [] ()
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
, txBody
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- Largely lifted from inlineToOpenXML' in T.P.W.Docx. Can't be easily
|
|
Packit Service |
d2f85f |
-- abstracted because of some different namespaces and monads. TODO.
|
|
Packit Service |
d2f85f |
makePicElement :: PandocMonad m
|
|
Packit Service |
d2f85f |
=> MediaInfo
|
|
Packit Service |
d2f85f |
-> Text.Pandoc.Definition.Attr
|
|
Packit Service |
d2f85f |
-> P m Element
|
|
Packit Service |
d2f85f |
makePicElement mInfo attr = do
|
|
Packit Service |
d2f85f |
opts <- asks envOpts
|
|
Packit Service |
d2f85f |
pageWidth <- presSizeWidth <$> asks envPresentationSize
|
|
Packit Service |
d2f85f |
pageHeight <- getPageHeight <$> asks envPresentationSize
|
|
Packit Service |
d2f85f |
hasHeader <- asks envSlideHasHeader
|
|
Packit Service |
d2f85f |
let hasCaption = mInfoCaption mInfo
|
|
Packit Service |
d2f85f |
(imgBytes, _) <- P.fetchItem (mInfoFilePath mInfo)
|
|
Packit Service |
d2f85f |
-- We're not using x exts
|
|
Packit Service |
d2f85f |
((hXoff, hYoff), (_, hYext)) <- if hasHeader
|
|
Packit Service |
d2f85f |
then getHeaderSize
|
|
Packit Service |
d2f85f |
else return ((0, 0), (0, 0))
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let ((capX, capY), (_, _)) = if hasCaption
|
|
Packit Service |
d2f85f |
then captionPosition
|
|
Packit Service |
d2f85f |
else ((0,0), (0,0))
|
|
Packit Service |
d2f85f |
let (xpt,ypt) = desiredSizeInPoints opts attr
|
|
Packit Service |
d2f85f |
(either (const def) id (imageSize opts imgBytes))
|
|
Packit Service |
d2f85f |
-- 12700 emu = 1 pt
|
|
Packit Service |
d2f85f |
let (xemu,yemu) = fitToPage' (xpt * 12700, ypt * 12700)
|
|
Packit Service |
d2f85f |
((pageWidth * 12700) - (2 * hXoff) - (2 * capX))
|
|
Packit Service |
d2f85f |
((if hasCaption then capY else (pageHeight * 12700)) - (hYoff + hYext))
|
|
Packit Service |
d2f85f |
(xoff, yoff) = positionImage (xpt * 12700, ypt * 12700) (pageWidth * 12700) (pageHeight * 12700)
|
|
Packit Service |
d2f85f |
xoff' = if hasHeader then xoff + hXoff else xoff
|
|
Packit Service |
d2f85f |
xoff'' = if hasCaption then xoff' + capX else xoff'
|
|
Packit Service |
d2f85f |
yoff' = if hasHeader then hYoff + hYext else yoff
|
|
Packit Service |
d2f85f |
-- let (xemu,yemu)=((floor $ xpt * 12700), (floor $ ypt * 12700))
|
|
Packit Service |
d2f85f |
let cNvPicPr = mknode "p:cNvPicPr" [] $
|
|
Packit Service |
d2f85f |
mknode "a:picLocks" [("noGrp","1")
|
|
Packit Service |
d2f85f |
,("noChangeAspect","1")] ()
|
|
Packit Service |
d2f85f |
let nvPicPr = mknode "p:nvPicPr" []
|
|
Packit Service |
d2f85f |
[ mknode "p:cNvPr"
|
|
Packit Service |
d2f85f |
[("descr", mInfoFilePath mInfo),("id","0"),("name","Picture 1")] ()
|
|
Packit Service |
d2f85f |
, cNvPicPr
|
|
Packit Service |
d2f85f |
, mknode "p:nvPr" [] ()]
|
|
Packit Service |
d2f85f |
let blipFill = mknode "p:blipFill" []
|
|
Packit Service |
d2f85f |
[ mknode "a:blip" [("r:embed", "rId" ++ (show $ mInfoLocalId mInfo))] ()
|
|
Packit Service |
d2f85f |
, mknode "a:stretch" [] $
|
|
Packit Service |
d2f85f |
mknode "a:fillRect" [] () ]
|
|
Packit Service |
d2f85f |
let xfrm = mknode "a:xfrm" []
|
|
Packit Service |
d2f85f |
[ mknode "a:off" [("x",show xoff''), ("y",show yoff')] ()
|
|
Packit Service |
d2f85f |
, mknode "a:ext" [("cx",show xemu)
|
|
Packit Service |
d2f85f |
,("cy",show yemu)] () ]
|
|
Packit Service |
d2f85f |
let prstGeom = mknode "a:prstGeom" [("prst","rect")] $
|
|
Packit Service |
d2f85f |
mknode "a:avLst" [] ()
|
|
Packit Service |
d2f85f |
let ln = mknode "a:ln" [("w","9525")]
|
|
Packit Service |
d2f85f |
[ mknode "a:noFill" [] ()
|
|
Packit Service |
d2f85f |
, mknode "a:headEnd" [] ()
|
|
Packit Service |
d2f85f |
, mknode "a:tailEnd" [] () ]
|
|
Packit Service |
d2f85f |
let spPr = mknode "p:spPr" [("bwMode","auto")]
|
|
Packit Service |
d2f85f |
[xfrm, prstGeom, mknode "a:noFill" [] (), ln]
|
|
Packit Service |
d2f85f |
return $
|
|
Packit Service |
d2f85f |
mknode "p:pic" []
|
|
Packit Service |
d2f85f |
[ nvPicPr
|
|
Packit Service |
d2f85f |
, blipFill
|
|
Packit Service |
d2f85f |
, spPr ]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- Currently hardcoded, until I figure out how to make it dynamic.
|
|
Packit Service |
d2f85f |
blockQuoteSize :: Pixels
|
|
Packit Service |
d2f85f |
blockQuoteSize = 20
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
noteSize :: Pixels
|
|
Packit Service |
d2f85f |
noteSize = 18
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
paraElemToElement :: PandocMonad m => ParaElem -> P m Element
|
|
Packit Service |
d2f85f |
paraElemToElement Break = return $ mknode "a:br" [] ()
|
|
Packit Service |
d2f85f |
paraElemToElement (Run rpr s) = do
|
|
Packit Service |
d2f85f |
let attrs =
|
|
Packit Service |
d2f85f |
if rPropCode rpr
|
|
Packit Service |
d2f85f |
then []
|
|
Packit Service |
d2f85f |
else (case rPropForceSize rpr of
|
|
Packit Service |
d2f85f |
Just n -> [("sz", (show $ n * 100))]
|
|
Packit Service |
d2f85f |
Nothing -> []) ++
|
|
Packit Service |
d2f85f |
(if rPropBold rpr then [("b", "1")] else []) ++
|
|
Packit Service |
d2f85f |
(if rPropItalics rpr then [("i", "1")] else []) ++
|
|
Packit Service |
d2f85f |
(case rStrikethrough rpr of
|
|
Packit Service |
d2f85f |
Just NoStrike -> [("strike", "noStrike")]
|
|
Packit Service |
d2f85f |
Just SingleStrike -> [("strike", "sngStrike")]
|
|
Packit Service |
d2f85f |
Just DoubleStrike -> [("strike", "dblStrike")]
|
|
Packit Service |
d2f85f |
Nothing -> []) ++
|
|
Packit Service |
d2f85f |
(case rBaseline rpr of
|
|
Packit Service |
d2f85f |
Just n -> [("baseline", show n)]
|
|
Packit Service |
d2f85f |
Nothing -> []) ++
|
|
Packit Service |
d2f85f |
(case rCap rpr of
|
|
Packit Service |
d2f85f |
Just NoCapitals -> [("cap", "none")]
|
|
Packit Service |
d2f85f |
Just SmallCapitals -> [("cap", "small")]
|
|
Packit Service |
d2f85f |
Just AllCapitals -> [("cap", "all")]
|
|
Packit Service |
d2f85f |
Nothing -> []) ++
|
|
Packit Service |
d2f85f |
[]
|
|
Packit Service |
d2f85f |
linkProps <- case rLink rpr of
|
|
Packit Service |
d2f85f |
Just link -> do idNum <- registerLink link
|
|
Packit Service |
d2f85f |
return [mknode "a:hlinkClick"
|
|
Packit Service |
d2f85f |
[("r:id", "rId" ++ show idNum)]
|
|
Packit Service |
d2f85f |
()
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
Nothing -> return []
|
|
Packit Service |
d2f85f |
let propContents = if rPropCode rpr
|
|
Packit Service |
d2f85f |
then [mknode "a:latin" [("typeface", "Courier")] ()]
|
|
Packit Service |
d2f85f |
else linkProps
|
|
Packit Service |
d2f85f |
return $ mknode "a:r" [] [ mknode "a:rPr" attrs propContents
|
|
Packit Service |
d2f85f |
, mknode "a:t" [] s
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
paraElemToElement (MathElem mathType texStr) = do
|
|
Packit Service |
d2f85f |
res <- convertMath writeOMML mathType (unTeXString texStr)
|
|
Packit Service |
d2f85f |
case res of
|
|
Packit Service |
d2f85f |
Right r -> return $ mknode "a14:m" [] $ addMathInfo r
|
|
Packit Service |
d2f85f |
Left (Str s) -> paraElemToElement (Run def s)
|
|
Packit Service |
d2f85f |
Left _ -> throwError $ PandocShouldNeverHappenError "non-string math fallback"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- This is a bit of a kludge -- really requires adding an option to
|
|
Packit Service |
d2f85f |
-- TeXMath, but since that's a different package, we'll do this one
|
|
Packit Service |
d2f85f |
-- step at a time.
|
|
Packit Service |
d2f85f |
addMathInfo :: Element -> Element
|
|
Packit Service |
d2f85f |
addMathInfo element =
|
|
Packit Service |
d2f85f |
let mathspace = Attr { attrKey = (QName "m" Nothing (Just "xmlns"))
|
|
Packit Service |
d2f85f |
, attrVal = "http://schemas.openxmlformats.org/officeDocument/2006/math"
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
in add_attr mathspace element
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- We look through the element to see if it contains an a14:m
|
|
Packit Service |
d2f85f |
-- element. If so, we surround it. This is a bit ugly, but it seems
|
|
Packit Service |
d2f85f |
-- more dependable than looking through shapes for math. Plus this is
|
|
Packit Service |
d2f85f |
-- an xml implementation detail, so it seems to make sense to do it at
|
|
Packit Service |
d2f85f |
-- the xml level.
|
|
Packit Service |
d2f85f |
surroundWithMathAlternate :: Element -> Element
|
|
Packit Service |
d2f85f |
surroundWithMathAlternate element =
|
|
Packit Service |
d2f85f |
case findElement (QName "m" Nothing (Just "a14")) element of
|
|
Packit Service |
d2f85f |
Just _ ->
|
|
Packit Service |
d2f85f |
mknode "mc:AlternateContent"
|
|
Packit Service |
d2f85f |
[("xmlns:mc", "http://schemas.openxmlformats.org/markup-compatibility/2006")
|
|
Packit Service |
d2f85f |
] [ mknode "mc:Choice"
|
|
Packit Service |
d2f85f |
[ ("xmlns:a14", "http://schemas.microsoft.com/office/drawing/2010/main")
|
|
Packit Service |
d2f85f |
, ("Requires", "a14")] [ element ]
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
Nothing -> element
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
paragraphToElement :: PandocMonad m => Paragraph -> P m Element
|
|
Packit Service |
d2f85f |
paragraphToElement par = do
|
|
Packit Service |
d2f85f |
let
|
|
Packit Service |
d2f85f |
attrs = [("lvl", show $ pPropLevel $ paraProps par)] ++
|
|
Packit Service |
d2f85f |
(case pPropMarginLeft (paraProps par) of
|
|
Packit Service |
d2f85f |
Just px -> [("marL", show $ 12700 * px), ("indent", "0")]
|
|
Packit Service |
d2f85f |
Nothing -> []
|
|
Packit Service |
d2f85f |
) ++
|
|
Packit Service |
d2f85f |
(case pPropAlign (paraProps par) of
|
|
Packit Service |
d2f85f |
Just AlgnLeft -> [("algn", "l")]
|
|
Packit Service |
d2f85f |
Just AlgnRight -> [("algn", "r")]
|
|
Packit Service |
d2f85f |
Just AlgnCenter -> [("algn", "ctr")]
|
|
Packit Service |
d2f85f |
Nothing -> []
|
|
Packit Service |
d2f85f |
)
|
|
Packit Service |
d2f85f |
props = [] ++
|
|
Packit Service |
d2f85f |
(case pPropBullet $ paraProps par of
|
|
Packit Service |
d2f85f |
Just Bullet -> []
|
|
Packit Service |
d2f85f |
Just (AutoNumbering attrs') ->
|
|
Packit Service |
d2f85f |
[mknode "a:buAutoNum" [("type", autoNumberingToType attrs')] ()]
|
|
Packit Service |
d2f85f |
Nothing -> [mknode "a:buNone" [] ()]
|
|
Packit Service |
d2f85f |
)
|
|
Packit Service |
d2f85f |
paras <- mapM paraElemToElement (paraElems par)
|
|
Packit Service |
d2f85f |
return $ mknode "a:p" [] $ [mknode "a:pPr" attrs props] ++ paras
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
shapeToElement :: PandocMonad m => Element -> Shape -> P m Element
|
|
Packit Service |
d2f85f |
shapeToElement layout (TextBox paras)
|
|
Packit Service |
d2f85f |
| ns <- elemToNameSpaces layout
|
|
Packit Service |
d2f85f |
, Just cSld <- findChild (elemName ns "p" "cSld") layout
|
|
Packit Service |
d2f85f |
, Just spTree <- findChild (elemName ns "p" "spTree") cSld
|
|
Packit Service |
d2f85f |
, Just sp <- getContentShape ns spTree = do
|
|
Packit Service |
d2f85f |
elements <- mapM paragraphToElement paras
|
|
Packit Service |
d2f85f |
let txBody = mknode "p:txBody" [] $
|
|
Packit Service |
d2f85f |
[mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ elements
|
|
Packit Service |
d2f85f |
emptySpPr = mknode "p:spPr" [] ()
|
|
Packit Service |
d2f85f |
return $
|
|
Packit Service |
d2f85f |
surroundWithMathAlternate $
|
|
Packit Service |
d2f85f |
replaceNamedChildren ns "p" "txBody" [txBody] $
|
|
Packit Service |
d2f85f |
replaceNamedChildren ns "p" "spPr" [emptySpPr] $
|
|
Packit Service |
d2f85f |
sp
|
|
Packit Service |
d2f85f |
-- XXX: TODO
|
|
Packit Service |
d2f85f |
| otherwise = return $ mknode "p:sp" [] ()
|
|
Packit Service |
d2f85f |
-- XXX: TODO
|
|
Packit Service |
d2f85f |
shapeToElement layout (Pic fp attr alt) = do
|
|
Packit Service |
d2f85f |
mInfo <- registerMedia fp alt
|
|
Packit Service |
d2f85f |
case mInfoExt mInfo of
|
|
Packit Service |
d2f85f |
Just _ -> makePicElement mInfo attr
|
|
Packit Service |
d2f85f |
Nothing -> shapeToElement layout $ TextBox [Paragraph def alt]
|
|
Packit Service |
d2f85f |
shapeToElement _ (GraphicFrame tbls _) = do
|
|
Packit Service |
d2f85f |
elements <- mapM graphicToElement tbls
|
|
Packit Service |
d2f85f |
return $ mknode "p:graphicFrame" [] $
|
|
Packit Service |
d2f85f |
[ mknode "p:nvGraphicFramePr" [] $
|
|
Packit Service |
d2f85f |
[ mknode "p:cNvPr" [("id", "6"), ("name", "Content Placeholder 5")] ()
|
|
Packit Service |
d2f85f |
, mknode "p:cNvGraphicFramePr" [] $
|
|
Packit Service |
d2f85f |
[mknode "a:graphicFrameLocks" [("noGrp", "1")] ()]
|
|
Packit Service |
d2f85f |
, mknode "p:nvPr" [] $
|
|
Packit Service |
d2f85f |
[mknode "p:ph" [("idx", "1")] ()]
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
, mknode "p:xfrm" [] $
|
|
Packit Service |
d2f85f |
[ mknode "a:off" [("x", "457200"), ("y", "1600200")] ()
|
|
Packit Service |
d2f85f |
, mknode "a:ext" [("cx", "8029388"), ("cy", "3644152")] ()
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
] ++ elements
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
shapeToElements :: PandocMonad m => Element -> Shape -> P m [Element]
|
|
Packit Service |
d2f85f |
shapeToElements layout shp = do
|
|
Packit Service |
d2f85f |
case shp of
|
|
Packit Service |
d2f85f |
(Pic _ _ alt) | (not . null) alt -> do
|
|
Packit Service |
d2f85f |
element <- shapeToElement layout shp
|
|
Packit Service |
d2f85f |
caption <- createCaption alt
|
|
Packit Service |
d2f85f |
return [element, caption]
|
|
Packit Service |
d2f85f |
(GraphicFrame _ cptn) | (not . null) cptn -> do
|
|
Packit Service |
d2f85f |
element <- shapeToElement layout shp
|
|
Packit Service |
d2f85f |
caption <- createCaption cptn
|
|
Packit Service |
d2f85f |
return [element, caption]
|
|
Packit Service |
d2f85f |
_ -> do
|
|
Packit Service |
d2f85f |
element <- shapeToElement layout shp
|
|
Packit Service |
d2f85f |
return [element]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
shapesToElements :: PandocMonad m => Element -> [Shape] -> P m [Element]
|
|
Packit Service |
d2f85f |
shapesToElements layout shps = do
|
|
Packit Service |
d2f85f |
concat <$> mapM (shapeToElements layout) shps
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
hardcodedTableMargin :: Integer
|
|
Packit Service |
d2f85f |
hardcodedTableMargin = 36
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
graphicToElement :: PandocMonad m => Graphic -> P m Element
|
|
Packit Service |
d2f85f |
graphicToElement (Tbl tblPr colWidths hdrCells rows) = do
|
|
Packit Service |
d2f85f |
let cellToOpenXML paras = do elements <- mapM paragraphToElement paras
|
|
Packit Service |
d2f85f |
return $
|
|
Packit Service |
d2f85f |
[mknode "a:txBody" [] $
|
|
Packit Service |
d2f85f |
([ mknode "a:bodyPr" [] ()
|
|
Packit Service |
d2f85f |
, mknode "a:lstStyle" [] ()]
|
|
Packit Service |
d2f85f |
++ elements)]
|
|
Packit Service |
d2f85f |
headers' <- mapM cellToOpenXML hdrCells
|
|
Packit Service |
d2f85f |
rows' <- mapM (mapM cellToOpenXML) rows
|
|
Packit Service |
d2f85f |
let borderProps = mknode "a:tcPr" [] ()
|
|
Packit Service |
d2f85f |
let emptyCell = [mknode "a:p" [] [mknode "a:pPr" [] ()]]
|
|
Packit Service |
d2f85f |
let mkcell border contents = mknode "a:tc" []
|
|
Packit Service |
d2f85f |
$ (if null contents
|
|
Packit Service |
d2f85f |
then emptyCell
|
|
Packit Service |
d2f85f |
else contents) ++ [ borderProps | border ]
|
|
Packit Service |
d2f85f |
let mkrow border cells = mknode "a:tr" [("h", "0")] $ map (mkcell border) cells
|
|
Packit Service |
d2f85f |
-- let textwidth = 14400 -- 5.5 in in twips, 1/20 pt
|
|
Packit Service |
d2f85f |
-- let fullrow = 14400 -- 100% specified in pct
|
|
Packit Service |
d2f85f |
-- let rowwidth = fullrow * sum colWidths
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let mkgridcol w = mknode "a:gridCol"
|
|
Packit Service |
d2f85f |
[("w", show ((12700 * w) :: Integer))] ()
|
|
Packit Service |
d2f85f |
let hasHeader = not (all null hdrCells)
|
|
Packit Service |
d2f85f |
return $ mknode "a:graphic" [] $
|
|
Packit Service |
d2f85f |
[mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")] $
|
|
Packit Service |
d2f85f |
[mknode "a:tbl" [] $
|
|
Packit Service |
d2f85f |
[ mknode "a:tblPr" [ ("firstRow", if tblPrFirstRow tblPr then "1" else "0")
|
|
Packit Service |
d2f85f |
, ("bandRow", if tblPrBandRow tblPr then "1" else "0")
|
|
Packit Service |
d2f85f |
] ()
|
|
Packit Service |
d2f85f |
, mknode "a:tblGrid" [] (if all (==0) colWidths
|
|
Packit Service |
d2f85f |
then []
|
|
Packit Service |
d2f85f |
else map mkgridcol colWidths)
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
++ [ mkrow True headers' | hasHeader ] ++ map (mkrow False) rows'
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
getShapeByName :: NameSpaces -> Element -> String -> Maybe Element
|
|
Packit Service |
d2f85f |
getShapeByName ns spTreeElem name
|
|
Packit Service |
d2f85f |
| isElem ns "p" "spTree" spTreeElem =
|
|
Packit Service |
d2f85f |
filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns name e)) spTreeElem
|
|
Packit Service |
d2f85f |
| otherwise = Nothing
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
nonBodyTextToElement :: PandocMonad m => Element -> String -> [ParaElem] -> P m Element
|
|
Packit Service |
d2f85f |
nonBodyTextToElement layout shapeName paraElements
|
|
Packit Service |
d2f85f |
| ns <- elemToNameSpaces layout
|
|
Packit Service |
d2f85f |
, Just cSld <- findChild (elemName ns "p" "cSld") layout
|
|
Packit Service |
d2f85f |
, Just spTree <- findChild (elemName ns "p" "spTree") cSld
|
|
Packit Service |
d2f85f |
, Just sp <- getShapeByName ns spTree shapeName = do
|
|
Packit Service |
d2f85f |
let hdrPara = Paragraph def paraElements
|
|
Packit Service |
d2f85f |
element <- paragraphToElement hdrPara
|
|
Packit Service |
d2f85f |
let txBody = mknode "p:txBody" [] $
|
|
Packit Service |
d2f85f |
[mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++
|
|
Packit Service |
d2f85f |
[element]
|
|
Packit Service |
d2f85f |
return $ replaceNamedChildren ns "p" "txBody" [txBody] sp
|
|
Packit Service |
d2f85f |
-- XXX: TODO
|
|
Packit Service |
d2f85f |
| otherwise = return $ mknode "p:sp" [] ()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- hdrToElement :: Element -> [ParaElem] -> Element
|
|
Packit Service |
d2f85f |
-- hdrToElement layout paraElems
|
|
Packit Service |
d2f85f |
-- | ns <- elemToNameSpaces layout
|
|
Packit Service |
d2f85f |
-- , Just cSld <- findChild (elemName ns "p" "cSld") layout
|
|
Packit Service |
d2f85f |
-- , Just spTree <- findChild (elemName ns "p" "spTree") cSld
|
|
Packit Service |
d2f85f |
-- , Just sp <- getContentTitleShape ns spTree =
|
|
Packit Service |
d2f85f |
-- let hdrPara = Paragraph def paraElems
|
|
Packit Service |
d2f85f |
-- txBody = mknode "p:txBody" [] $
|
|
Packit Service |
d2f85f |
-- [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++
|
|
Packit Service |
d2f85f |
-- [paragraphToElement hdrPara]
|
|
Packit Service |
d2f85f |
-- in
|
|
Packit Service |
d2f85f |
-- replaceNamedChildren ns "p" "txBody" [txBody] sp
|
|
Packit Service |
d2f85f |
-- -- XXX: TODO
|
|
Packit Service |
d2f85f |
-- | otherwise = mknode "p:sp" [] ()
|
|
Packit Service |
d2f85f |
-- -- XXX: TODO
|
|
Packit Service |
d2f85f |
-- hdrToElement _ _ = mknode "p:sp" [] ()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
contentToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> P m Element
|
|
Packit Service |
d2f85f |
contentToElement layout hdrShape shapes
|
|
Packit Service |
d2f85f |
| ns <- elemToNameSpaces layout
|
|
Packit Service |
d2f85f |
, Just cSld <- findChild (elemName ns "p" "cSld") layout
|
|
Packit Service |
d2f85f |
, Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
|
|
Packit Service |
d2f85f |
element <- nonBodyTextToElement layout "Title 1" hdrShape
|
|
Packit Service |
d2f85f |
let hdrShapeElements = if null hdrShape
|
|
Packit Service |
d2f85f |
then []
|
|
Packit Service |
d2f85f |
else [element]
|
|
Packit Service |
d2f85f |
contentElements <- shapesToElements layout shapes
|
|
Packit Service |
d2f85f |
return $
|
|
Packit Service |
d2f85f |
replaceNamedChildren ns "p" "sp"
|
|
Packit Service |
d2f85f |
(hdrShapeElements ++ contentElements)
|
|
Packit Service |
d2f85f |
spTree
|
|
Packit Service |
d2f85f |
contentToElement _ _ _ = return $ mknode "p:sp" [] ()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
titleToElement :: PandocMonad m => Element -> [ParaElem] -> P m Element
|
|
Packit Service |
d2f85f |
titleToElement layout titleElems
|
|
Packit Service |
d2f85f |
| ns <- elemToNameSpaces layout
|
|
Packit Service |
d2f85f |
, Just cSld <- findChild (elemName ns "p" "cSld") layout
|
|
Packit Service |
d2f85f |
, Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
|
|
Packit Service |
d2f85f |
element <- nonBodyTextToElement layout "Title 1" titleElems
|
|
Packit Service |
d2f85f |
let titleShapeElements = if null titleElems
|
|
Packit Service |
d2f85f |
then []
|
|
Packit Service |
d2f85f |
else [element]
|
|
Packit Service |
d2f85f |
return $ replaceNamedChildren ns "p" "sp" titleShapeElements spTree
|
|
Packit Service |
d2f85f |
titleToElement _ _ = return $ mknode "p:sp" [] ()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
metadataToElement :: PandocMonad m => Element -> [ParaElem] -> [ParaElem] -> [[ParaElem]] -> [ParaElem] -> P m Element
|
|
Packit Service |
d2f85f |
metadataToElement layout titleElems subtitleElems authorsElems dateElems
|
|
Packit Service |
d2f85f |
| ns <- elemToNameSpaces layout
|
|
Packit Service |
d2f85f |
, Just cSld <- findChild (elemName ns "p" "cSld") layout
|
|
Packit Service |
d2f85f |
, Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
|
|
Packit Service |
d2f85f |
titleShapeElements <- if null titleElems
|
|
Packit Service |
d2f85f |
then return []
|
|
Packit Service |
d2f85f |
else sequence [nonBodyTextToElement layout "Title 1" titleElems]
|
|
Packit Service |
d2f85f |
let combinedAuthorElems = intercalate [Break] authorsElems
|
|
Packit Service |
d2f85f |
subtitleAndAuthorElems = intercalate [Break, Break] [subtitleElems, combinedAuthorElems]
|
|
Packit Service |
d2f85f |
subtitleShapeElements <- if null subtitleAndAuthorElems
|
|
Packit Service |
d2f85f |
then return []
|
|
Packit Service |
d2f85f |
else sequence [nonBodyTextToElement layout "Subtitle 2" subtitleAndAuthorElems]
|
|
Packit Service |
d2f85f |
dateShapeElements <- if null dateElems
|
|
Packit Service |
d2f85f |
then return []
|
|
Packit Service |
d2f85f |
else sequence [nonBodyTextToElement layout "Date Placeholder 3" dateElems]
|
|
Packit Service |
d2f85f |
return $ replaceNamedChildren ns "p" "sp"
|
|
Packit Service |
d2f85f |
(titleShapeElements ++ subtitleShapeElements ++ dateShapeElements)
|
|
Packit Service |
d2f85f |
spTree
|
|
Packit Service |
d2f85f |
metadataToElement _ _ _ _ _ = return $ mknode "p:sp" [] ()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
slideToElement :: PandocMonad m => Slide -> P m Element
|
|
Packit Service |
d2f85f |
slideToElement s@(ContentSlide hdrElems shapes) = do
|
|
Packit Service |
d2f85f |
layout <- getLayout s
|
|
Packit Service |
d2f85f |
spTree <- local (\env -> if null hdrElems
|
|
Packit Service |
d2f85f |
then env
|
|
Packit Service |
d2f85f |
else env{envSlideHasHeader=True}) $
|
|
Packit Service |
d2f85f |
contentToElement layout hdrElems shapes
|
|
Packit Service |
d2f85f |
return $ mknode "p:sld"
|
|
Packit Service |
d2f85f |
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
|
|
Packit Service |
d2f85f |
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
|
|
Packit Service |
d2f85f |
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
|
|
Packit Service |
d2f85f |
] [mknode "p:cSld" [] [spTree]]
|
|
Packit Service |
d2f85f |
slideToElement s@(TitleSlide hdrElems) = do
|
|
Packit Service |
d2f85f |
layout <- getLayout s
|
|
Packit Service |
d2f85f |
spTree <- titleToElement layout hdrElems
|
|
Packit Service |
d2f85f |
return $ mknode "p:sld"
|
|
Packit Service |
d2f85f |
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
|
|
Packit Service |
d2f85f |
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
|
|
Packit Service |
d2f85f |
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
|
|
Packit Service |
d2f85f |
] [mknode "p:cSld" [] [spTree]]
|
|
Packit Service |
d2f85f |
slideToElement s@(MetadataSlide titleElems subtitleElems authorElems dateElems) = do
|
|
Packit Service |
d2f85f |
layout <- getLayout s
|
|
Packit Service |
d2f85f |
spTree <- metadataToElement layout titleElems subtitleElems authorElems dateElems
|
|
Packit Service |
d2f85f |
return $ mknode "p:sld"
|
|
Packit Service |
d2f85f |
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
|
|
Packit Service |
d2f85f |
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
|
|
Packit Service |
d2f85f |
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
|
|
Packit Service |
d2f85f |
] [mknode "p:cSld" [] [spTree]]
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-----------------------------------------------------------------------
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
slideToFilePath :: Slide -> Int -> FilePath
|
|
Packit Service |
d2f85f |
slideToFilePath _ idNum = "slide" ++ (show $ idNum) ++ ".xml"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
slideToSlideId :: Monad m => Slide -> Int -> P m String
|
|
Packit Service |
d2f85f |
slideToSlideId _ idNum = do
|
|
Packit Service |
d2f85f |
n <- gets stSlideIdOffset
|
|
Packit Service |
d2f85f |
return $ "rId" ++ (show $ idNum + n)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data Relationship = Relationship { relId :: Int
|
|
Packit Service |
d2f85f |
, relType :: MimeType
|
|
Packit Service |
d2f85f |
, relTarget :: FilePath
|
|
Packit Service |
d2f85f |
} deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
elementToRel :: Element -> Maybe Relationship
|
|
Packit Service |
d2f85f |
elementToRel element
|
|
Packit Service |
d2f85f |
| elName element == QName "Relationship" (Just "http://schemas.openxmlformats.org/package/2006/relationships") Nothing =
|
|
Packit Service |
d2f85f |
do rId <- findAttr (QName "Id" Nothing Nothing) element
|
|
Packit Service |
d2f85f |
numStr <- stripPrefix "rId" rId
|
|
Packit Service |
d2f85f |
num <- case reads numStr :: [(Int, String)] of
|
|
Packit Service |
d2f85f |
(n, _) : _ -> Just n
|
|
Packit Service |
d2f85f |
[] -> Nothing
|
|
Packit Service |
d2f85f |
type' <- findAttr (QName "Type" Nothing Nothing) element
|
|
Packit Service |
d2f85f |
target <- findAttr (QName "Target" Nothing Nothing) element
|
|
Packit Service |
d2f85f |
return $ Relationship num type' target
|
|
Packit Service |
d2f85f |
| otherwise = Nothing
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
slideToPresRel :: Monad m => Slide -> Int -> P m Relationship
|
|
Packit Service |
d2f85f |
slideToPresRel slide idNum = do
|
|
Packit Service |
d2f85f |
n <- gets stSlideIdOffset
|
|
Packit Service |
d2f85f |
let rId = idNum + n
|
|
Packit Service |
d2f85f |
fp = "slides/" ++ slideToFilePath slide idNum
|
|
Packit Service |
d2f85f |
return $ Relationship { relId = rId
|
|
Packit Service |
d2f85f |
, relType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide"
|
|
Packit Service |
d2f85f |
, relTarget = fp
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
getRels :: PandocMonad m => P m [Relationship]
|
|
Packit Service |
d2f85f |
getRels = do
|
|
Packit Service |
d2f85f |
refArchive <- asks envRefArchive
|
|
Packit Service |
d2f85f |
distArchive <- asks envDistArchive
|
|
Packit Service |
d2f85f |
relsElem <- parseXml refArchive distArchive "ppt/_rels/presentation.xml.rels"
|
|
Packit Service |
d2f85f |
let globalNS = "http://schemas.openxmlformats.org/package/2006/relationships"
|
|
Packit Service |
d2f85f |
let relElems = findChildren (QName "Relationship" (Just globalNS) Nothing) relsElem
|
|
Packit Service |
d2f85f |
return $ mapMaybe elementToRel relElems
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
presentationToRels :: PandocMonad m => Presentation -> P m [Relationship]
|
|
Packit Service |
d2f85f |
presentationToRels (Presentation _ slides) = do
|
|
Packit Service |
d2f85f |
mySlideRels <- mapM (\(s, n) -> slideToPresRel s n) $ zip slides [1..]
|
|
Packit Service |
d2f85f |
rels <- getRels
|
|
Packit Service |
d2f85f |
let relsWithoutSlides = filter (\r -> relType r /= "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") rels
|
|
Packit Service |
d2f85f |
-- We want to make room for the slides in the id space. The slides
|
|
Packit Service |
d2f85f |
-- will start at Id2 (since Id1 is for the slide master). There are
|
|
Packit Service |
d2f85f |
-- two slides in the data file, but that might change in the future,
|
|
Packit Service |
d2f85f |
-- so we will do this:
|
|
Packit Service |
d2f85f |
--
|
|
Packit Service |
d2f85f |
-- 1. We look to see what the minimum relWithoutSlide id (greater than 1) is.
|
|
Packit Service |
d2f85f |
-- 2. We add the difference between this and the number of slides to
|
|
Packit Service |
d2f85f |
-- all relWithoutSlide rels (unless they're 1)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let minRelNotOne = case filter (1<) $ map relId relsWithoutSlides of
|
|
Packit Service |
d2f85f |
[] -> 0 -- doesn't matter in this case, since
|
|
Packit Service |
d2f85f |
-- there will be nothing to map the
|
|
Packit Service |
d2f85f |
-- function over
|
|
Packit Service |
d2f85f |
l -> minimum l
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
modifyRelNum :: Int -> Int
|
|
Packit Service |
d2f85f |
modifyRelNum 1 = 1
|
|
Packit Service |
d2f85f |
modifyRelNum n = n - minRelNotOne + 2 + length slides
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
relsWithoutSlides' = map (\r -> r{relId = modifyRelNum $ relId r}) relsWithoutSlides
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
return $ mySlideRels ++ relsWithoutSlides'
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
relToElement :: Relationship -> Element
|
|
Packit Service |
d2f85f |
relToElement rel = mknode "Relationship" [ ("Id", "rId" ++ (show $ relId rel))
|
|
Packit Service |
d2f85f |
, ("Type", relType rel)
|
|
Packit Service |
d2f85f |
, ("Target", relTarget rel) ] ()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
relsToElement :: [Relationship] -> Element
|
|
Packit Service |
d2f85f |
relsToElement rels = mknode "Relationships"
|
|
Packit Service |
d2f85f |
[("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
|
|
Packit Service |
d2f85f |
(map relToElement rels)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
presentationToRelsEntry :: PandocMonad m => Presentation -> P m Entry
|
|
Packit Service |
d2f85f |
presentationToRelsEntry pres = do
|
|
Packit Service |
d2f85f |
rels <- presentationToRels pres
|
|
Packit Service |
d2f85f |
elemToEntry "ppt/_rels/presentation.xml.rels" $ relsToElement rels
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
elemToEntry :: PandocMonad m => FilePath -> Element -> P m Entry
|
|
Packit Service |
d2f85f |
elemToEntry fp element = do
|
|
Packit Service |
d2f85f |
epochtime <- (floor . utcTimeToPOSIXSeconds) <$> asks envUTCTime
|
|
Packit Service |
d2f85f |
return $ toEntry fp epochtime $ renderXml element
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
slideToEntry :: PandocMonad m => Slide -> Int -> P m Entry
|
|
Packit Service |
d2f85f |
slideToEntry slide idNum = do
|
|
Packit Service |
d2f85f |
modify $ \st -> st{stCurSlideId = idNum}
|
|
Packit Service |
d2f85f |
element <- slideToElement slide
|
|
Packit Service |
d2f85f |
elemToEntry ("ppt/slides/" ++ slideToFilePath slide idNum) element
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
slideToSlideRelEntry :: PandocMonad m => Slide -> Int -> P m Entry
|
|
Packit Service |
d2f85f |
slideToSlideRelEntry slide idNum = do
|
|
Packit Service |
d2f85f |
element <- slideToSlideRelElement slide idNum
|
|
Packit Service |
d2f85f |
elemToEntry ("ppt/slides/_rels/" ++ slideToFilePath slide idNum ++ ".rels") element
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
linkRelElement :: Int -> (URL, String) -> Element
|
|
Packit Service |
d2f85f |
linkRelElement idNum (url, _) =
|
|
Packit Service |
d2f85f |
mknode "Relationship" [ ("Id", "rId" ++ show idNum)
|
|
Packit Service |
d2f85f |
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")
|
|
Packit Service |
d2f85f |
, ("Target", url)
|
|
Packit Service |
d2f85f |
, ("TargetMode", "External")
|
|
Packit Service |
d2f85f |
] ()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
linkRelElements :: M.Map Int (URL, String) -> [Element]
|
|
Packit Service |
d2f85f |
linkRelElements mp = map (\(n, lnk) -> linkRelElement n lnk) (M.toList mp)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
mediaRelElement :: MediaInfo -> Element
|
|
Packit Service |
d2f85f |
mediaRelElement mInfo =
|
|
Packit Service |
d2f85f |
let ext = case mInfoExt mInfo of
|
|
Packit Service |
d2f85f |
Just e -> e
|
|
Packit Service |
d2f85f |
Nothing -> ""
|
|
Packit Service |
d2f85f |
in
|
|
Packit Service |
d2f85f |
mknode "Relationship" [ ("Id", "rId" ++ (show $ mInfoLocalId mInfo))
|
|
Packit Service |
d2f85f |
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image")
|
|
Packit Service |
d2f85f |
, ("Target", "../media/image" ++ (show $ mInfoGlobalId mInfo) ++ ext)
|
|
Packit Service |
d2f85f |
] ()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
slideToSlideRelElement :: PandocMonad m => Slide -> Int -> P m Element
|
|
Packit Service |
d2f85f |
slideToSlideRelElement slide idNum = do
|
|
Packit Service |
d2f85f |
let target = case slide of
|
|
Packit Service |
d2f85f |
(MetadataSlide _ _ _ _) -> "../slideLayouts/slideLayout1.xml"
|
|
Packit Service |
d2f85f |
(TitleSlide _) -> "../slideLayouts/slideLayout3.xml"
|
|
Packit Service |
d2f85f |
(ContentSlide _ _) -> "../slideLayouts/slideLayout2.xml"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
linkIds <- gets stLinkIds
|
|
Packit Service |
d2f85f |
mediaIds <- gets stMediaIds
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let linkRels = case M.lookup idNum linkIds of
|
|
Packit Service |
d2f85f |
Just mp -> linkRelElements mp
|
|
Packit Service |
d2f85f |
Nothing -> []
|
|
Packit Service |
d2f85f |
mediaRels = case M.lookup idNum mediaIds of
|
|
Packit Service |
d2f85f |
Just mInfos -> map mediaRelElement mInfos
|
|
Packit Service |
d2f85f |
Nothing -> []
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
return $
|
|
Packit Service |
d2f85f |
mknode "Relationships"
|
|
Packit Service |
d2f85f |
[("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
|
|
Packit Service |
d2f85f |
([mknode "Relationship" [ ("Id", "rId1")
|
|
Packit Service |
d2f85f |
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout")
|
|
Packit Service |
d2f85f |
, ("Target", target)] ()
|
|
Packit Service |
d2f85f |
] ++ linkRels ++ mediaRels)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- slideToSlideRelEntry :: PandocMonad m => Slide -> Int -> P m Entry
|
|
Packit Service |
d2f85f |
-- slideToSlideRelEntry slide idNum = do
|
|
Packit Service |
d2f85f |
-- let fp = "ppt/slides/_rels/slide" ++ (show idNum) ++ ".xml.rels"
|
|
Packit Service |
d2f85f |
-- elemToEntry fp $ slideToSlideRelElement slide
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
slideToSldIdElement :: PandocMonad m => Slide -> Int -> P m Element
|
|
Packit Service |
d2f85f |
slideToSldIdElement slide idNum = do
|
|
Packit Service |
d2f85f |
let id' = show $ idNum + 255
|
|
Packit Service |
d2f85f |
rId <- slideToSlideId slide idNum
|
|
Packit Service |
d2f85f |
return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] ()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element
|
|
Packit Service |
d2f85f |
presentationToSldIdLst (Presentation _ slides) = do
|
|
Packit Service |
d2f85f |
ids <- mapM (\(s,n) -> slideToSldIdElement s n) (zip slides [1..])
|
|
Packit Service |
d2f85f |
return $ mknode "p:sldIdLst" [] ids
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
presentationToPresentationElement :: PandocMonad m => Presentation -> P m Element
|
|
Packit Service |
d2f85f |
presentationToPresentationElement pres = do
|
|
Packit Service |
d2f85f |
refArchive <- asks envRefArchive
|
|
Packit Service |
d2f85f |
distArchive <- asks envDistArchive
|
|
Packit Service |
d2f85f |
element <- parseXml refArchive distArchive "ppt/presentation.xml"
|
|
Packit Service |
d2f85f |
sldIdLst <- presentationToSldIdLst pres
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
let modifySldIdLst :: Content -> Content
|
|
Packit Service |
d2f85f |
modifySldIdLst (Elem e) = case elName e of
|
|
Packit Service |
d2f85f |
(QName "sldIdLst" _ _) -> Elem sldIdLst
|
|
Packit Service |
d2f85f |
_ -> Elem e
|
|
Packit Service |
d2f85f |
modifySldIdLst ct = ct
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
newContent = map modifySldIdLst $ elContent element
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
return $ element{elContent = newContent}
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
presentationToPresEntry :: PandocMonad m => Presentation -> P m Entry
|
|
Packit Service |
d2f85f |
presentationToPresEntry pres = presentationToPresentationElement pres >>=
|
|
Packit Service |
d2f85f |
elemToEntry "ppt/presentation.xml"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
defaultContentTypeToElem :: DefaultContentType -> Element
|
|
Packit Service |
d2f85f |
defaultContentTypeToElem dct =
|
|
Packit Service |
d2f85f |
mknode "Default"
|
|
Packit Service |
d2f85f |
[("Extension", defContentTypesExt dct),
|
|
Packit Service |
d2f85f |
("ContentType", defContentTypesType dct)]
|
|
Packit Service |
d2f85f |
()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
overrideContentTypeToElem :: OverrideContentType -> Element
|
|
Packit Service |
d2f85f |
overrideContentTypeToElem oct =
|
|
Packit Service |
d2f85f |
mknode "Override"
|
|
Packit Service |
d2f85f |
[("PartName", overrideContentTypesPart oct),
|
|
Packit Service |
d2f85f |
("ContentType", overrideContentTypesType oct)]
|
|
Packit Service |
d2f85f |
()
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
contentTypesToElement :: ContentTypes -> Element
|
|
Packit Service |
d2f85f |
contentTypesToElement ct =
|
|
Packit Service |
d2f85f |
let ns = "http://schemas.openxmlformats.org/package/2006/content-types"
|
|
Packit Service |
d2f85f |
in
|
|
Packit Service |
d2f85f |
mknode "Types" [("xmlns", ns)] $
|
|
Packit Service |
d2f85f |
(map defaultContentTypeToElem $ contentTypesDefaults ct) ++
|
|
Packit Service |
d2f85f |
(map overrideContentTypeToElem $ contentTypesOverrides ct)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data DefaultContentType = DefaultContentType
|
|
Packit Service |
d2f85f |
{ defContentTypesExt :: String
|
|
Packit Service |
d2f85f |
, defContentTypesType:: MimeType
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data OverrideContentType = OverrideContentType
|
|
Packit Service |
d2f85f |
{ overrideContentTypesPart :: FilePath
|
|
Packit Service |
d2f85f |
, overrideContentTypesType :: MimeType
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
data ContentTypes = ContentTypes { contentTypesDefaults :: [DefaultContentType]
|
|
Packit Service |
d2f85f |
, contentTypesOverrides :: [OverrideContentType]
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
deriving (Show, Eq)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
contentTypesToEntry :: PandocMonad m => ContentTypes -> P m Entry
|
|
Packit Service |
d2f85f |
contentTypesToEntry ct = elemToEntry "[Content_Types].xml" $ contentTypesToElement ct
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
pathToOverride :: FilePath -> Maybe OverrideContentType
|
|
Packit Service |
d2f85f |
pathToOverride fp = OverrideContentType ("/" ++ fp) <$> (getContentType fp)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
mediaContentType :: MediaInfo -> Maybe DefaultContentType
|
|
Packit Service |
d2f85f |
mediaContentType mInfo
|
|
Packit Service |
d2f85f |
| Just ('.' : ext) <- mInfoExt mInfo =
|
|
Packit Service |
d2f85f |
Just $ DefaultContentType { defContentTypesExt = ext
|
|
Packit Service |
d2f85f |
, defContentTypesType =
|
|
Packit Service |
d2f85f |
case mInfoMimeType mInfo of
|
|
Packit Service |
d2f85f |
Just mt -> mt
|
|
Packit Service |
d2f85f |
Nothing -> "application/octet-stream"
|
|
Packit Service |
d2f85f |
}
|
|
Packit Service |
d2f85f |
| otherwise = Nothing
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes
|
|
Packit Service |
d2f85f |
presentationToContentTypes (Presentation _ slides) = do
|
|
Packit Service |
d2f85f |
mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds
|
|
Packit Service |
d2f85f |
let defaults = [ DefaultContentType "xml" "application/xml"
|
|
Packit Service |
d2f85f |
, DefaultContentType "rels" "application/vnd.openxmlformats-package.relationships+xml"
|
|
Packit Service |
d2f85f |
]
|
|
Packit Service |
d2f85f |
mediaDefaults = nub $ mapMaybe mediaContentType mediaInfos
|
|
Packit Service |
d2f85f |
inheritedOverrides = mapMaybe pathToOverride inheritedFiles
|
|
Packit Service |
d2f85f |
presOverride = mapMaybe pathToOverride ["ppt/presentation.xml"]
|
|
Packit Service |
d2f85f |
slideOverrides =
|
|
Packit Service |
d2f85f |
mapMaybe
|
|
Packit Service |
d2f85f |
(\(s, n) ->
|
|
Packit Service |
d2f85f |
pathToOverride $ "ppt/slides/" ++ slideToFilePath s n)
|
|
Packit Service |
d2f85f |
(zip slides [1..])
|
|
Packit Service |
d2f85f |
-- propOverride = mapMaybe pathToOverride ["docProps/core.xml"]
|
|
Packit Service |
d2f85f |
return $ ContentTypes
|
|
Packit Service |
d2f85f |
(defaults ++ mediaDefaults)
|
|
Packit Service |
d2f85f |
(inheritedOverrides ++ presOverride ++ slideOverrides)
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
-- slideToElement :: Element -> Slide -> Element
|
|
Packit Service |
d2f85f |
-- slideToElement layout (ContentSlide _ shapes) =
|
|
Packit Service |
d2f85f |
-- let sps = map (shapeToElement layout) shapes
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
presML :: String
|
|
Packit Service |
d2f85f |
presML = "application/vnd.openxmlformats-officedocument.presentationml"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
noPresML :: String
|
|
Packit Service |
d2f85f |
noPresML = "application/vnd.openxmlformats-officedocument"
|
|
Packit Service |
d2f85f |
|
|
Packit Service |
d2f85f |
getContentType :: FilePath -> Maybe MimeType
|
|
Packit Service |
d2f85f |
getContentType fp
|
|
Packit Service |
d2f85f |
| fp == "ppt/presentation.xml" = Just $ presML ++ ".presentation.main+xml"
|
|
Packit Service |
d2f85f |
| fp == "ppt/presProps.xml" = Just $ presML ++ ".presProps+xml"
|
|
Packit Service |
d2f85f |
| fp == "ppt/viewProps.xml" = Just $ presML ++ ".viewProps+xml"
|
|
Packit Service |
d2f85f |
| fp == "ppt/tableStyles.xml" = Just $ presML ++ ".tableStyles+xml"
|
|
Packit Service |
d2f85f |
| fp == "docProps/core.xml" = Just $ "application/vnd.openxmlformats-package.core-properties+xml"
|
|
Packit Service |
d2f85f |
| fp == "docProps/app.xml" = Just $ noPresML ++ ".extended-properties+xml"
|
|
Packit Service |
d2f85f |
| "ppt" : "slideMasters" : f : [] <- splitDirectories fp
|
|
Packit Service |
d2f85f |
, (_, ".xml") <- splitExtension f =
|
|
Packit Service |
d2f85f |
Just $ presML ++ ".slideMaster+xml"
|
|
Packit Service |
d2f85f |
| "ppt" : "slides" : f : [] <- splitDirectories fp
|
|
Packit Service |
d2f85f |
, (_, ".xml") <- splitExtension f =
|
|
Packit Service |
d2f85f |
Just $ presML ++ ".slide+xml"
|
|
Packit Service |
d2f85f |
| "ppt" : "notesMasters" : f : [] <- splitDirectories fp
|
|
Packit Service |
d2f85f |
, (_, ".xml") <- splitExtension f =
|
|
Packit Service |
d2f85f |
Just $ presML ++ ".notesMaster+xml"
|
|
Packit Service |
d2f85f |
| "ppt" : "notesSlides" : f : [] <- splitDirectories fp
|
|
Packit Service |
d2f85f |
, (_, ".xml") <- splitExtension f =
|
|
Packit Service |
d2f85f |
Just $ presML ++ ".notesSlide+xml"
|
|
Packit Service |
d2f85f |
| "ppt" : "theme" : f : [] <- splitDirectories fp
|
|
Packit Service |
d2f85f |
, (_, ".xml") <- splitExtension f =
|
|
Packit Service |
d2f85f |
Just $ noPresML ++ ".theme+xml"
|
|
Packit Service |
d2f85f |
| "ppt" : "slideLayouts" : _ : [] <- splitDirectories fp=
|
|
Packit Service |
d2f85f |
Just $ presML ++ ".slideLayout+xml"
|
|
Packit Service |
d2f85f |
| otherwise = Nothing
|