diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r-- | src/Text/Pandoc/Writers/Custom.hs | 149 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/OOXML.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint.hs | 72 |
3 files changed, 107 insertions, 118 deletions
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 87b97dcee..72f443ed0 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -1,11 +1,5 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} -#if MIN_VERSION_base(4,8,0) -#else -{-# LANGUAGE OverlappingInstances #-} -#endif {- Copyright (C) 2012-2017 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify @@ -36,19 +30,23 @@ Conversion of 'Pandoc' documents to custom markup using a lua writer. -} module Text.Pandoc.Writers.Custom ( writeCustom ) where +import Control.Arrow ((***)) import Control.Exception import Control.Monad (when) +import Control.Monad.Trans (MonadIO (liftIO)) import Data.Char (toLower) import Data.List (intersperse) import qualified Data.Map as M import Data.Text (Text, pack) import Data.Typeable -import Foreign.Lua (Lua, ToLuaStack (..), callFunc, runLua) +import Foreign.Lua (Lua, ToLuaStack (..), callFunc) import Foreign.Lua.Api -import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8) +import Text.Pandoc.Class (PandocIO) import Text.Pandoc.Definition import Text.Pandoc.Error -import Text.Pandoc.Lua.Util (addValue) +import Text.Pandoc.Lua.Init (runPandocLua) +import Text.Pandoc.Lua.StackInstances () +import Text.Pandoc.Lua.Util (addValue, dostring') import Text.Pandoc.Options import Text.Pandoc.Templates import qualified Text.Pandoc.UTF8 as UTF8 @@ -60,43 +58,31 @@ attrToMap (id',classes,keyvals) = M.fromList : ("class", unwords classes) : keyvals -instance ToLuaStack Double where - push = push . (realToFrac :: Double -> LuaNumber) - -instance ToLuaStack Int where - push = push . (fromIntegral :: Int -> LuaInteger) - -instance ToLuaStack Format where - push (Format f) = push (map toLower f) - -#if MIN_VERSION_base(4,8,0) -instance {-# OVERLAPS #-} ToLuaStack [Inline] where -#else -instance ToLuaStack [Inline] where -#endif - push ils = push =<< inlineListToCustom ils - -#if MIN_VERSION_base(4,8,0) -instance {-# OVERLAPS #-} ToLuaStack [Block] where -#else -instance ToLuaStack [Block] where -#endif - push ils = push =<< blockListToCustom ils - -instance ToLuaStack MetaValue where - push (MetaMap m) = push m - push (MetaList xs) = push xs - push (MetaBool x) = push x - push (MetaString s) = push s - push (MetaInlines ils) = push ils - push (MetaBlocks bs) = push bs - -instance ToLuaStack Citation where - push cit = do +newtype Stringify a = Stringify a + +instance ToLuaStack (Stringify Format) where + push (Stringify (Format f)) = push (map toLower f) + +instance ToLuaStack (Stringify [Inline]) where + push (Stringify ils) = push =<< inlineListToCustom ils + +instance ToLuaStack (Stringify [Block]) where + push (Stringify blks) = push =<< blockListToCustom blks + +instance ToLuaStack (Stringify MetaValue) where + push (Stringify (MetaMap m)) = push (fmap Stringify m) + push (Stringify (MetaList xs)) = push (map Stringify xs) + push (Stringify (MetaBool x)) = push x + push (Stringify (MetaString s)) = push s + push (Stringify (MetaInlines ils)) = push (Stringify ils) + push (Stringify (MetaBlocks bs)) = push (Stringify bs) + +instance ToLuaStack (Stringify Citation) where + push (Stringify cit) = do createtable 6 0 addValue "citationId" $ citationId cit - addValue "citationPrefix" $ citationPrefix cit - addValue "citationSuffix" $ citationSuffix cit + addValue "citationPrefix" . Stringify $ citationPrefix cit + addValue "citationSuffix" . Stringify $ citationSuffix cit addValue "citationMode" $ show (citationMode cit) addValue "citationNoteNum" $ citationNoteNum cit addValue "citationHash" $ citationHash cit @@ -107,14 +93,11 @@ data PandocLuaException = PandocLuaException String instance Exception PandocLuaException -- | Convert Pandoc to custom markup. -writeCustom :: FilePath -> WriterOptions -> Pandoc -> IO Text +writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text writeCustom luaFile opts doc@(Pandoc meta _) = do - luaScript <- UTF8.readFile luaFile - enc <- getForeignEncoding - setForeignEncoding utf8 - (body, context) <- runLua $ do - openlibs - stat <- loadstring luaScript + luaScript <- liftIO $ UTF8.readFile luaFile + res <- runPandocLua $ do + stat <- dostring' luaScript -- check for error in lua script (later we'll change the return type -- to handle this more gracefully): when (stat /= OK) $ @@ -127,7 +110,9 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do inlineListToCustom meta return (rendered, context) - setForeignEncoding enc + let (body, context) = case res of + Left e -> throw (PandocLuaException (show e)) + Right x -> x case writerTemplate opts of Nothing -> return $ pack body Just tpl -> @@ -138,7 +123,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do docToCustom :: WriterOptions -> Pandoc -> Lua String docToCustom opts (Pandoc (Meta metamap) blocks) = do body <- blockListToCustom blocks - callFunc "Doc" body metamap (writerVariables opts) + callFunc "Doc" body (fmap Stringify metamap) (writerVariables opts) -- | Convert Pandoc block element to Custom. blockToCustom :: Block -- ^ Block element @@ -146,41 +131,45 @@ blockToCustom :: Block -- ^ Block element blockToCustom Null = return "" -blockToCustom (Plain inlines) = callFunc "Plain" inlines +blockToCustom (Plain inlines) = callFunc "Plain" (Stringify inlines) blockToCustom (Para [Image attr txt (src,tit)]) = - callFunc "CaptionedImage" src tit txt (attrToMap attr) + callFunc "CaptionedImage" src tit (Stringify txt) (attrToMap attr) -blockToCustom (Para inlines) = callFunc "Para" inlines +blockToCustom (Para inlines) = callFunc "Para" (Stringify inlines) -blockToCustom (LineBlock linesList) = callFunc "LineBlock" linesList +blockToCustom (LineBlock linesList) = callFunc "LineBlock" (map Stringify linesList) blockToCustom (RawBlock format str) = - callFunc "RawBlock" format str + callFunc "RawBlock" (Stringify format) str blockToCustom HorizontalRule = callFunc "HorizontalRule" blockToCustom (Header level attr inlines) = - callFunc "Header" level inlines (attrToMap attr) + callFunc "Header" level (Stringify inlines) (attrToMap attr) blockToCustom (CodeBlock attr str) = callFunc "CodeBlock" str (attrToMap attr) -blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" blocks +blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" (Stringify blocks) -blockToCustom (Table capt aligns widths headers rows') = - callFunc "Table" capt (map show aligns) widths headers rows' +blockToCustom (Table capt aligns widths headers rows) = + let aligns' = map show aligns + capt' = Stringify capt + headers' = map Stringify headers + rows' = map (map Stringify) rows + in callFunc "Table" capt' aligns' widths headers' rows' -blockToCustom (BulletList items) = callFunc "BulletList" items +blockToCustom (BulletList items) = callFunc "BulletList" (map Stringify items) blockToCustom (OrderedList (num,sty,delim) items) = - callFunc "OrderedList" items num (show sty) (show delim) + callFunc "OrderedList" (map Stringify items) num (show sty) (show delim) blockToCustom (DefinitionList items) = - callFunc "DefinitionList" items + callFunc "DefinitionList" (map (Stringify *** map Stringify) items) blockToCustom (Div attr items) = - callFunc "Div" items (attrToMap attr) + callFunc "Div" (Stringify items) (attrToMap attr) -- | Convert list of Pandoc block elements to Custom. blockListToCustom :: [Block] -- ^ List of block elements @@ -205,23 +194,23 @@ inlineToCustom Space = callFunc "Space" inlineToCustom SoftBreak = callFunc "SoftBreak" -inlineToCustom (Emph lst) = callFunc "Emph" lst +inlineToCustom (Emph lst) = callFunc "Emph" (Stringify lst) -inlineToCustom (Strong lst) = callFunc "Strong" lst +inlineToCustom (Strong lst) = callFunc "Strong" (Stringify lst) -inlineToCustom (Strikeout lst) = callFunc "Strikeout" lst +inlineToCustom (Strikeout lst) = callFunc "Strikeout" (Stringify lst) -inlineToCustom (Superscript lst) = callFunc "Superscript" lst +inlineToCustom (Superscript lst) = callFunc "Superscript" (Stringify lst) -inlineToCustom (Subscript lst) = callFunc "Subscript" lst +inlineToCustom (Subscript lst) = callFunc "Subscript" (Stringify lst) -inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" lst +inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" (Stringify lst) -inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" lst +inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" (Stringify lst) -inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" lst +inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" (Stringify lst) -inlineToCustom (Cite cs lst) = callFunc "Cite" lst cs +inlineToCustom (Cite cs lst) = callFunc "Cite" (Stringify lst) (map Stringify cs) inlineToCustom (Code attr str) = callFunc "Code" str (attrToMap attr) @@ -233,17 +222,17 @@ inlineToCustom (Math InlineMath str) = callFunc "InlineMath" str inlineToCustom (RawInline format str) = - callFunc "RawInline" format str + callFunc "RawInline" (Stringify format) str inlineToCustom LineBreak = callFunc "LineBreak" inlineToCustom (Link attr txt (src,tit)) = - callFunc "Link" txt src tit (attrToMap attr) + callFunc "Link" (Stringify txt) src tit (attrToMap attr) inlineToCustom (Image attr alt (src,tit)) = - callFunc "Image" alt src tit (attrToMap attr) + callFunc "Image" (Stringify alt) src tit (attrToMap attr) -inlineToCustom (Note contents) = callFunc "Note" contents +inlineToCustom (Note contents) = callFunc "Note" (Stringify contents) inlineToCustom (Span attr items) = - callFunc "Span" items (attrToMap attr) + callFunc "Span" (Stringify items) (attrToMap attr) diff --git a/src/Text/Pandoc/Writers/OOXML.hs b/src/Text/Pandoc/Writers/OOXML.hs index f48d27bd6..aa4979653 100644 --- a/src/Text/Pandoc/Writers/OOXML.hs +++ b/src/Text/Pandoc/Writers/OOXML.hs @@ -76,12 +76,12 @@ parseXml refArchive distArchive relpath = Nothing -> fail $ relpath ++ " corrupt in reference file" Just d -> return d --- Copied from Util +-- Copied from Util attrToNSPair :: XML.Attr -> Maybe (String, String) attrToNSPair (XML.Attr (QName s _ (Just "xmlns")) val) = Just (s, val) attrToNSPair _ = Nothing - + elemToNameSpaces :: Element -> NameSpaces elemToNameSpaces = mapMaybe attrToNSPair . elAttribs diff --git a/src/Text/Pandoc/Writers/Powerpoint.hs b/src/Text/Pandoc/Writers/Powerpoint.hs index d78833c81..b5f06c581 100644 --- a/src/Text/Pandoc/Writers/Powerpoint.hs +++ b/src/Text/Pandoc/Writers/Powerpoint.hs @@ -174,7 +174,7 @@ getPageHeight :: PresentationSize -> Pixels getPageHeight sz = case presSizeRatio sz of Ratio4x3 -> floor (((fromInteger (presSizeWidth sz)) / 4) * 3 :: Double) Ratio16x9 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 9 :: Double) - Ratio16x10 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 10 :: Double) + Ratio16x10 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 10 :: Double) instance Default PresentationSize where def = PresentationSize 720 Ratio4x3 @@ -183,7 +183,7 @@ data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem] , metadataSlideSubtitle :: [ParaElem] , metadataSlideAuthors :: [[ParaElem]] , metadataSlideDate :: [ParaElem] - } + } | TitleSlide { titleSlideHeader :: [ParaElem]} | ContentSlide { contentSlideHeader :: [ParaElem] , contentSlideContent :: [Shape] @@ -206,7 +206,7 @@ data TableProps = TableProps { tblPrFirstRow :: Bool type ColWidth = Integer -data Graphic = Tbl TableProps [ColWidth] [Cell] [[Cell]] +data Graphic = Tbl TableProps [ColWidth] [Cell] [[Cell]] deriving (Show, Eq) @@ -217,7 +217,7 @@ data Paragraph = Paragraph { paraProps :: ParaProps data HeaderType = TitleHeader | SlideHeader | InternalHeader Int deriving (Show, Eq) --- type StartingAt = Int +-- type StartingAt = Int -- data AutoNumType = ArabicNum -- | AlphaUpperNum @@ -362,7 +362,7 @@ blockToParagraphs (Plain ils) = do return [Paragraph pProps parElems] blockToParagraphs (Para ils) = do parElems <- inlinesToParElems ils - pProps <- asks envParaProps + pProps <- asks envParaProps return [Paragraph pProps parElems] blockToParagraphs (LineBlock ilsList) = do parElems <- inlinesToParElems $ intercalate [LineBreak] ilsList @@ -380,9 +380,9 @@ blockToParagraphs (BlockQuote blks) = -- TODO: work out the format blockToParagraphs (RawBlock _ _) = return [] -- parElems <- inlinesToParElems [Str str] - -- paraProps <- asks envParaProps + -- paraProps <- asks envParaProps -- return [Paragraph paraProps parElems] --- TODO: work out the format +-- TODO: work out the format blockToParagraphs (Header n _ ils) = do slideLevel <- asks envSlideLevel parElems <- inlinesToParElems ils @@ -490,7 +490,7 @@ splitBlocks' cur acc (h@(Header n _ _) : blks) = do EQ -> splitBlocks' [h] (acc ++ (if null cur then [] else [cur])) blks GT -> splitBlocks' (cur ++ [h]) acc blks splitBlocks' cur acc ((Para (img@(Image _ _ _):ils)) : blks) = do - slideLevel <- asks envSlideLevel + slideLevel <- asks envSlideLevel case cur of (Header n _ _) : [] | n == slideLevel -> splitBlocks' [] @@ -500,7 +500,7 @@ splitBlocks' cur acc ((Para (img@(Image _ _ _):ils)) : blks) = do (acc ++ (if null cur then [] else [cur]) ++ [[Para [img]]]) (if null ils then blks else (Para ils) : blks) splitBlocks' cur acc ((Plain (img@(Image _ _ _):ils)) : blks) = do - slideLevel <- asks envSlideLevel + slideLevel <- asks envSlideLevel case cur of (Header n _ _) : [] | n == slideLevel -> splitBlocks' [] @@ -510,7 +510,7 @@ splitBlocks' cur acc ((Plain (img@(Image _ _ _):ils)) : blks) = do (acc ++ (if null cur then [] else [cur]) ++ [[Para [img]]]) (if null ils then blks else (Plain ils) : blks) splitBlocks' cur acc (tbl@(Table _ _ _ _ _) : blks) = do - slideLevel <- asks envSlideLevel + slideLevel <- asks envSlideLevel case cur of (Header n _ _) : [] | n == slideLevel -> splitBlocks' [] (acc ++ [cur ++ [tbl]]) blks @@ -592,7 +592,7 @@ getMediaFiles = do distArchive <- asks envDistArchive let allEntries = nub $ filesInArchive refArchive ++ filesInArchive distArchive return $ filter (isPrefixOf "ppt/media") allEntries - + copyFileToArchiveIfExists :: PandocMonad m => Archive -> FilePath -> P m Archive copyFileToArchiveIfExists arch fp = do @@ -635,7 +635,7 @@ inheritedFiles = [ "_rels/.rels" -- , "ppt/slides/_rels/slide2.xml.rels" -- This is the one we're -- going to build - -- , "ppt/slides/slide2.xml" + -- , "ppt/slides/slide2.xml" -- , "ppt/slides/slide1.xml" , "ppt/viewProps.xml" , "ppt/tableStyles.xml" @@ -670,7 +670,7 @@ presentationToArchive p@(Presentation _ slides) = do slideEntries ++ slideRelEntries ++ mediaEntries ++ - [contentTypesEntry, presEntry, presRelsEntry] + [contentTypesEntry, presEntry, presRelsEntry] -------------------------------------------------- @@ -726,25 +726,25 @@ shapeHasName ns name element -- getContentTitleShape :: NameSpaces -> Element -> Maybe Element -- getContentTitleShape ns spTreeElem --- | isElem ns "p" "spTree" spTreeElem = +-- | isElem ns "p" "spTree" spTreeElem = -- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Title 1" e)) spTreeElem -- | otherwise = Nothing -- getSubtitleShape :: NameSpaces -> Element -> Maybe Element -- getSubtitleShape ns spTreeElem --- | isElem ns "p" "spTree" spTreeElem = +-- | isElem ns "p" "spTree" spTreeElem = -- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Subtitle 2" e)) spTreeElem -- | otherwise = Nothing -- getDateShape :: NameSpaces -> Element -> Maybe Element -- getDateShape ns spTreeElem --- | isElem ns "p" "spTree" spTreeElem = +-- | isElem ns "p" "spTree" spTreeElem = -- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Date Placeholder 3" e)) spTreeElem -- | otherwise = Nothing - + getContentShape :: NameSpaces -> Element -> Maybe Element getContentShape ns spTreeElem - | isElem ns "p" "spTree" spTreeElem = + | isElem ns "p" "spTree" spTreeElem = filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Content Placeholder 2" e)) spTreeElem | otherwise = Nothing @@ -831,7 +831,7 @@ registerMedia fp caption = do (imgBytes, mbMt) <- P.fetchItem fp let imgExt = (mbMt >>= extensionFromMimeType >>= (\x -> return $ '.':x)) - <|> + <|> case imageType imgBytes of Just Png -> Just ".png" Just Jpeg -> Just ".jpeg" @@ -840,7 +840,7 @@ registerMedia fp caption = do Just Eps -> Just ".eps" Just Svg -> Just ".svg" Nothing -> Nothing - + let newGlobalId = case M.lookup fp globalIds of Just ident -> ident Nothing -> maxGlobalId + 1 @@ -893,7 +893,7 @@ fitToPage' (x, y) pageWidth pageHeight (floor x, floor y) | x / fromIntegral pageWidth > y / fromIntegral pageWidth = (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y) - | otherwise = + | otherwise = (floor $ ((fromIntegral pageHeight) / y) * x, pageHeight) positionImage :: (Double, Double) -> Integer -> Integer -> (Integer, Integer) @@ -957,7 +957,7 @@ createCaption :: PandocMonad m => [ParaElem] -> P m Element createCaption paraElements = do let para = Paragraph def{pPropAlign = Just AlgnCenter} paraElements elements <- mapM paragraphToElement [para] - let ((x, y), (cx, cy)) = captionPosition + let ((x, y), (cx, cy)) = captionPosition let txBody = mknode "p:txBody" [] $ [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ elements return $ @@ -1041,7 +1041,7 @@ makePicElement mInfo attr = do , blipFill , spPr ] --- Currently hardcoded, until I figure out how to make it dynamic. +-- Currently hardcoded, until I figure out how to make it dynamic. blockQuoteSize :: Pixels blockQuoteSize = 20 @@ -1150,7 +1150,7 @@ shapeToElement layout (TextBox paras) [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ elements emptySpPr = mknode "p:spPr" [] () return $ - surroundWithMathAlternate $ + surroundWithMathAlternate $ replaceNamedChildren ns "p" "txBody" [txBody] $ replaceNamedChildren ns "p" "spPr" [emptySpPr] $ sp @@ -1199,7 +1199,7 @@ shapesToElements layout shps = do hardcodedTableMargin :: Integer hardcodedTableMargin = 36 - + graphicToElement :: PandocMonad m => Graphic -> P m Element graphicToElement (Tbl tblPr colWidths hdrCells rows) = do @@ -1241,7 +1241,7 @@ graphicToElement (Tbl tblPr colWidths hdrCells rows) = do getShapeByName :: NameSpaces -> Element -> String -> Maybe Element getShapeByName ns spTreeElem name - | isElem ns "p" "spTree" spTreeElem = + | isElem ns "p" "spTree" spTreeElem = filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns name e)) spTreeElem | otherwise = Nothing @@ -1266,7 +1266,7 @@ nonBodyTextToElement layout shapeName paraElements -- | ns <- elemToNameSpaces layout -- , Just cSld <- findChild (elemName ns "p" "cSld") layout -- , Just spTree <- findChild (elemName ns "p" "spTree") cSld --- , Just sp <- getContentTitleShape ns spTree = +-- , Just sp <- getContentTitleShape ns spTree = -- let hdrPara = Paragraph def paraElems -- txBody = mknode "p:txBody" [] $ -- [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ @@ -1387,7 +1387,7 @@ elementToRel element slideToPresRel :: Monad m => Slide -> Int -> P m Relationship slideToPresRel slide idNum = do - n <- gets stSlideIdOffset + n <- gets stSlideIdOffset let rId = idNum + n fp = "slides/" ++ slideToFilePath slide idNum return $ Relationship { relId = rId @@ -1429,7 +1429,7 @@ presentationToRels (Presentation _ slides) = do modifyRelNum n = n - minRelNotOne + 2 + length slides relsWithoutSlides' = map (\r -> r{relId = modifyRelNum $ relId r}) relsWithoutSlides - + return $ mySlideRels ++ relsWithoutSlides' relToElement :: Relationship -> Element @@ -1479,7 +1479,7 @@ mediaRelElement mInfo = let ext = case mInfoExt mInfo of Just e -> e Nothing -> "" - in + in mknode "Relationship" [ ("Id", "rId" ++ (show $ mInfoLocalId mInfo)) , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image") , ("Target", "../media/image" ++ (show $ mInfoGlobalId mInfo) ++ ext) @@ -1503,7 +1503,7 @@ slideToSlideRelElement slide idNum = do Nothing -> [] return $ - mknode "Relationships" + mknode "Relationships" [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")] ([mknode "Relationship" [ ("Id", "rId1") , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout") @@ -1546,9 +1546,9 @@ presentationToPresentationElement pres = do presentationToPresEntry :: PandocMonad m => Presentation -> P m Entry presentationToPresEntry pres = presentationToPresentationElement pres >>= elemToEntry "ppt/presentation.xml" - - + + defaultContentTypeToElem :: DefaultContentType -> Element defaultContentTypeToElem dct = @@ -1558,7 +1558,7 @@ defaultContentTypeToElem dct = () overrideContentTypeToElem :: OverrideContentType -> Element -overrideContentTypeToElem oct = +overrideContentTypeToElem oct = mknode "Override" [("PartName", overrideContentTypesPart oct), ("ContentType", overrideContentTypesType oct)] @@ -1571,7 +1571,7 @@ contentTypesToElement ct = mknode "Types" [("xmlns", ns)] $ (map defaultContentTypeToElem $ contentTypesDefaults ct) ++ (map overrideContentTypeToElem $ contentTypesOverrides ct) - + data DefaultContentType = DefaultContentType { defContentTypesExt :: String , defContentTypesType:: MimeType @@ -1634,7 +1634,7 @@ presML = "application/vnd.openxmlformats-officedocument.presentationml" noPresML :: String noPresML = "application/vnd.openxmlformats-officedocument" - + getContentType :: FilePath -> Maybe MimeType getContentType fp | fp == "ppt/presentation.xml" = Just $ presML ++ ".presentation.main+xml" |