aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2021-02-14 22:29:21 -0800
committerJohn MacFarlane <jgm@berkeley.edu>2021-02-16 16:55:20 -0800
commit967e7f5fb990b29de48b37be1db40fb149a8cf55 (patch)
treeb9f903a5f2af14f20e769903e80659b9bffd59ff /src/Text/Pandoc/Writers
parentb5b576184c3c1668aad0c904e186136b81a0dd54 (diff)
downloadpandoc-967e7f5fb990b29de48b37be1db40fb149a8cf55.tar.gz
Rename Text.Pandoc.XMLParser -> Text.Pandoc.XML.Light...
..and add new definitions isomorphic to xml-light's, but with Text instead of String. This allows us to keep most of the code in existing readers that use xml-light, but avoid lots of unnecessary allocation. We also add versions of the functions from xml-light's Text.XML.Light.Output and Text.XML.Light.Proc that operate on our modified XML types, and functions that convert xml-light types to our types (since some of our dependencies, like texmath, use xml-light). Update golden tests for docx and pptx. OOXML test: Use `showContent` instead of `ppContent` in `displayDiff`. Docx: Do a manual traversal to unwrap sdt and smartTag. This is faster, and needed to pass the tests. Benchmarks: A = prior to 8ca191604dcd13af27c11d2da225da646ebce6fc (Feb 8) B = as of 8ca191604dcd13af27c11d2da225da646ebce6fc (Feb 8) C = this commit | Reader | A | B | C | | ------- | ----- | ------ | ----- | | docbook | 18 ms | 12 ms | 10 ms | | opml | 65 ms | 62 ms | 35 ms | | jats | 15 ms | 11 ms | 9 ms | | docx | 72 ms | 69 ms | 44 ms | | odt | 78 ms | 41 ms | 28 ms | | epub | 64 ms | 61 ms | 56 ms | | fb2 | 14 ms | 5 ms | 4 ms |
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs263
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs356
-rw-r--r--src/Text/Pandoc/Writers/FB2.hs127
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs16
-rw-r--r--src/Text/Pandoc/Writers/OOXML.hs35
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs201
6 files changed, 485 insertions, 513 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index da990e4d3..89c71d773 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -31,6 +31,7 @@ import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing, mapMaybe, maybeToList)
import qualified Data.Set as Set
import qualified Data.Text as T
+import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import Data.Time.Clock.POSIX
import Data.Digest.Pure.SHA (sha1, showDigest)
@@ -57,19 +58,19 @@ import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
import Text.TeXMath
-import Text.XML.Light as XML
-import Text.XML.Light.Cursor as XMLC
import Text.Pandoc.Writers.OOXML
+import Text.Pandoc.XML.Light as XML
+import Data.Generics (mkT, everywhere)
data ListMarker = NoMarker
| BulletMarker
| NumberMarker ListNumberStyle ListNumberDelim Int
deriving (Show, Read, Eq, Ord)
-listMarkerToId :: ListMarker -> String
+listMarkerToId :: ListMarker -> Text
listMarkerToId NoMarker = "990"
listMarkerToId BulletMarker = "991"
-listMarkerToId (NumberMarker sty delim n) =
+listMarkerToId (NumberMarker sty delim n) = T.pack $
'9' : '9' : styNum : delimNum : show n
where styNum = case sty of
DefaultStyle -> '2'
@@ -106,8 +107,8 @@ data WriterEnv = WriterEnv{ envTextProperties :: EnvProps
, envListLevel :: Int
, envListNumId :: Int
, envInDel :: Bool
- , envChangesAuthor :: T.Text
- , envChangesDate :: T.Text
+ , envChangesAuthor :: Text
+ , envChangesDate :: Text
, envPrintWidth :: Integer
}
@@ -125,9 +126,9 @@ defaultWriterEnv = WriterEnv{ envTextProperties = mempty
data WriterState = WriterState{
stFootnotes :: [Element]
- , stComments :: [([(T.Text, T.Text)], [Inline])]
- , stSectionIds :: Set.Set T.Text
- , stExternalLinks :: M.Map String String
+ , stComments :: [([(Text, Text)], [Inline])]
+ , stSectionIds :: Set.Set Text
+ , stExternalLinks :: M.Map Text Text
, stImages :: M.Map FilePath (String, String, Maybe MimeType, B.ByteString)
, stLists :: [ListMarker]
, stInsId :: Int
@@ -164,18 +165,18 @@ defaultWriterState = WriterState{
type WS m = ReaderT WriterEnv (StateT WriterState m)
-renumIdMap :: Int -> [Element] -> M.Map String String
+renumIdMap :: Int -> [Element] -> M.Map Text Text
renumIdMap _ [] = M.empty
renumIdMap n (e:es)
| Just oldId <- findAttr (QName "Id" Nothing Nothing) e =
- M.insert oldId ("rId" ++ show n) (renumIdMap (n+1) es)
+ M.insert oldId ("rId" <> tshow n) (renumIdMap (n+1) es)
| otherwise = renumIdMap n es
-replaceAttr :: (QName -> Bool) -> String -> [XML.Attr] -> [XML.Attr]
+replaceAttr :: (QName -> Bool) -> Text -> [XML.Attr] -> [XML.Attr]
replaceAttr f val = map $
\a -> if f (attrKey a) then XML.Attr (attrKey a) val else a
-renumId :: (QName -> Bool) -> M.Map String String -> Element -> Element
+renumId :: (QName -> Bool) -> M.Map Text Text -> Element -> Element
renumId f renumMap e
| Just oldId <- findAttrBy f e
, Just newId <- M.lookup oldId renumMap =
@@ -184,18 +185,12 @@ renumId f renumMap e
e { elAttribs = attrs' }
| otherwise = e
-renumIds :: (QName -> Bool) -> M.Map String String -> [Element] -> [Element]
+renumIds :: (QName -> Bool) -> M.Map Text Text -> [Element] -> [Element]
renumIds f renumMap = map (renumId f renumMap)
-findAttrTextBy :: (QName -> Bool) -> Element -> Maybe T.Text
-findAttrTextBy x = fmap T.pack . findAttrBy x
-
-lookupAttrTextBy :: (QName -> Bool) -> [XML.Attr] -> Maybe T.Text
-lookupAttrTextBy x = fmap T.pack . lookupAttrBy x
-
-- | Certain characters are invalid in XML even if escaped.
-- See #1992
-stripInvalidChars :: T.Text -> T.Text
+stripInvalidChars :: Text -> Text
stripInvalidChars = T.filter isValidChar
-- | See XML reference
@@ -234,11 +229,11 @@ writeDocx opts doc = do
-- Gets the template size
let mbpgsz = mbsectpr >>= filterElementName (wname (=="pgSz"))
- let mbAttrSzWidth = mbpgsz >>= lookupAttrTextBy ((=="w") . qName) . elAttribs
+ let mbAttrSzWidth = mbpgsz >>= lookupAttrBy ((=="w") . qName) . elAttribs
let mbpgmar = mbsectpr >>= filterElementName (wname (=="pgMar"))
- let mbAttrMarLeft = mbpgmar >>= lookupAttrTextBy ((=="left") . qName) . elAttribs
- let mbAttrMarRight = mbpgmar >>= lookupAttrTextBy ((=="right") . qName) . elAttribs
+ let mbAttrMarLeft = mbpgmar >>= lookupAttrBy ((=="left") . qName) . elAttribs
+ let mbAttrMarRight = mbpgmar >>= lookupAttrBy ((=="right") . qName) . elAttribs
-- Get the available area (converting the size and the margins to int and
-- doing the difference
@@ -250,24 +245,21 @@ writeDocx opts doc = do
-- styles
mblang <- toLang $ getLang opts meta
+ -- TODO FIXME avoid this generic traversal!
+ -- lang is in w:docDefaults / w:rPr / w:lang
let addLang :: Element -> Element
- addLang e = case (\l -> XMLC.toTree . go (T.unpack $ renderLang l) $
- XMLC.fromElement e) <$> mblang of
- Just (Elem e') -> e'
- _ -> e -- return original
- where go :: String -> Cursor -> Cursor
- go l cursor = case XMLC.findRec (isLangElt . current) cursor of
- Nothing -> cursor
- Just t -> XMLC.modifyContent (setval l) t
- setval :: String -> Content -> Content
- setval l (Elem e') = Elem $ e'{ elAttribs = map (setvalattr l) $
- elAttribs e' }
- setval _ x = x
- setvalattr :: String -> XML.Attr -> XML.Attr
- setvalattr l (XML.Attr qn@(QName "val" _ _) _) = XML.Attr qn l
- setvalattr _ x = x
- isLangElt (Elem e') = qName (elName e') == "lang"
- isLangElt _ = False
+ addLang = case mblang of
+ Nothing -> id
+ Just l -> everywhere (mkT (go (renderLang l)))
+ where
+ go :: Text -> Element -> Element
+ go l e'
+ | qName (elName e') == "lang"
+ = e'{ elAttribs = map (setvalattr l) $ elAttribs e' }
+ | otherwise = e'
+
+ setvalattr l (XML.Attr qn@(QName "val" _ _) _) = XML.Attr qn l
+ setvalattr _ x = x
let stylepath = "word/styles.xml"
styledoc <- addLang <$> parseXml refArchive distArchive stylepath
@@ -337,12 +329,13 @@ writeDocx opts doc = do
-- [Content_Types].xml
let mkOverrideNode (part', contentType') = mknode "Override"
- [("PartName",part'),("ContentType",contentType')] ()
+ [("PartName", T.pack part')
+ ,("ContentType", contentType')] ()
let mkImageOverride (_, imgpath, mbMimeType, _) =
- mkOverrideNode ("/word/" ++ imgpath,
- maybe "application/octet-stream" T.unpack mbMimeType)
+ mkOverrideNode ("/word/" <> imgpath,
+ fromMaybe "application/octet-stream" mbMimeType)
let mkMediaOverride imgpath =
- mkOverrideNode ('/':imgpath, T.unpack $ getMimeTypeDef imgpath)
+ mkOverrideNode ("/" <> imgpath, getMimeTypeDef imgpath)
let overrides = map mkOverrideNode (
[("/word/webSettings.xml",
"application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")
@@ -369,13 +362,14 @@ writeDocx opts doc = do
,("/word/footnotes.xml",
"application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml")
] ++
- map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,
+ map (\x -> (maybe "" (T.unpack . ("/word/" <>)) (extractTarget x),
"application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml")) headers ++
- map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,
+ map (\x -> (maybe "" (T.unpack . ("/word/" <>)) (extractTarget x),
"application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml")) footers) ++
map mkImageOverride imgs ++
- [ mkMediaOverride (eRelativePath e) | e <- zEntries refArchive
- , "word/media/" `isPrefixOf` eRelativePath e ]
+ [ mkMediaOverride (eRelativePath e)
+ | e <- zEntries refArchive
+ , "word/media/" `isPrefixOf` eRelativePath e ]
let defaultnodes = [mknode "Default"
[("Extension","xml"),("ContentType","application/xml")] (),
@@ -421,7 +415,7 @@ writeDocx opts doc = do
let renumHeaders = renumIds (\q -> qName q == "Id") idMap headers
let renumFooters = renumIds (\q -> qName q == "Id") idMap footers
let baserels = baserels' ++ renumHeaders ++ renumFooters
- let toImgRel (ident,path,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()
+ let toImgRel (ident,path,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",T.pack ident),("Target",T.pack path)] ()
let imgrels = map toImgRel imgs
let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] ()
let linkrels = map toLinkRel $ M.toList $ stExternalLinks st
@@ -489,10 +483,10 @@ writeDocx opts doc = do
numbering <- parseXml refArchive distArchive numpath
let newNumElts = mkNumbering (stLists st)
let pandocAdded e =
- case findAttrTextBy ((== "abstractNumId") . qName) e >>= safeRead of
+ case findAttrBy ((== "abstractNumId") . qName) e >>= safeRead of
Just numid -> numid >= (990 :: Int)
Nothing ->
- case findAttrTextBy ((== "numId") . qName) e >>= safeRead of
+ case findAttrBy ((== "numId") . qName) e >>= safeRead of
Just numid -> numid >= (1000 :: Int)
Nothing -> False
let oldElts = filter (not . pandocAdded) $ onlyElems (elContent numbering)
@@ -514,7 +508,7 @@ writeDocx opts doc = do
let extraCoreProps = ["subject","lang","category","description"]
let extraCorePropsMap = M.fromList $ zip extraCoreProps
["dc:subject","dc:language","cp:category","dc:description"]
- let lookupMetaString' :: T.Text -> Meta -> T.Text
+ let lookupMetaString' :: Text -> Meta -> Text
lookupMetaString' key' meta' =
case key' of
"description" -> T.intercalate "_x000d_\n" (map stringify $ lookupMetaBlocks "description" meta')
@@ -530,21 +524,21 @@ writeDocx opts doc = do
: mktnode "dc:creator" [] (T.intercalate "; " (map stringify $ docAuthors meta))
: [ mktnode (M.findWithDefault "" k extraCorePropsMap) [] (lookupMetaString' k meta)
| k <- M.keys (unMeta meta), k `elem` extraCoreProps]
- ++ mknode "cp:keywords" [] (T.unpack $ T.intercalate ", " keywords)
+ ++ mknode "cp:keywords" [] (T.intercalate ", " keywords)
: (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x
, mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x
- ]) (formatTime defaultTimeLocale "%FT%XZ" utctime)
+ ]) (T.pack $ formatTime defaultTimeLocale "%FT%XZ" utctime)
let docPropsEntry = toEntry docPropsPath epochtime $ renderXml docProps
-- docProps/custom.xml
- let customProperties :: [(String, String)]
- customProperties = [ (T.unpack k, T.unpack $ lookupMetaString k meta)
+ let customProperties :: [(Text, Text)]
+ customProperties = [ (k, lookupMetaString k meta)
| k <- M.keys (unMeta meta)
, k `notElem` (["title", "author", "keywords"]
++ extraCoreProps)]
let mkCustomProp (k, v) pid = mknode "property"
[("fmtid","{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
- ,("pid", show pid)
+ ,("pid", tshow pid)
,("name", k)] $ mknode "vt:lpwstr" [] v
let customPropsPath = "docProps/custom.xml"
let customProps = mknode "Properties"
@@ -594,7 +588,8 @@ writeDocx opts doc = do
fontTableEntry <- entryFromArchive refArchive "word/fontTable.xml"
webSettingsEntry <- entryFromArchive refArchive "word/webSettings.xml"
headerFooterEntries <- mapM (entryFromArchive refArchive . ("word/" ++)) $
- mapMaybe extractTarget (headers ++ footers)
+ mapMaybe (fmap T.unpack . extractTarget)
+ (headers ++ footers)
let miscRelEntries = [ e | e <- zEntries refArchive
, "word/_rels/" `isPrefixOf` eRelativePath e
, ".xml.rels" `isSuffixOf` eRelativePath e
@@ -620,8 +615,8 @@ newParaPropToOpenXml (fromStyleName -> s) =
let styleId = T.filter (not . isSpace) s
in mknode "w:style" [ ("w:type", "paragraph")
, ("w:customStyle", "1")
- , ("w:styleId", T.unpack styleId)]
- [ mknode "w:name" [("w:val", T.unpack s)] ()
+ , ("w:styleId", styleId)]
+ [ mknode "w:name" [("w:val", s)] ()
, mknode "w:basedOn" [("w:val","BodyText")] ()
, mknode "w:qFormat" [] ()
]
@@ -631,8 +626,8 @@ newTextPropToOpenXml (fromStyleName -> s) =
let styleId = T.filter (not . isSpace) s
in mknode "w:style" [ ("w:type", "character")
, ("w:customStyle", "1")
- , ("w:styleId", T.unpack styleId)]
- [ mknode "w:name" [("w:val", T.unpack s)] ()
+ , ("w:styleId", styleId)]
+ [ mknode "w:name" [("w:val", s)] ()
, mknode "w:basedOn" [("w:val","BodyTextChar")] ()
]
@@ -643,13 +638,14 @@ styleToOpenXml sm style =
toStyle toktype | hasStyleName (fromString $ show toktype) (smCharStyle sm) = Nothing
| otherwise = Just $
mknode "w:style" [("w:type","character"),
- ("w:customStyle","1"),("w:styleId",show toktype)]
- [ mknode "w:name" [("w:val",show toktype)] ()
+ ("w:customStyle","1"),("w:styleId", tshow toktype)]
+ [ mknode "w:name" [("w:val", tshow toktype)] ()
, mknode "w:basedOn" [("w:val","VerbatimChar")] ()
, mknode "w:rPr" [] $
- [ mknode "w:color" [("w:val",tokCol toktype)] ()
+ [ mknode "w:color" [("w:val", tokCol toktype)] ()
| tokCol toktype /= "auto" ] ++
- [ mknode "w:shd" [("w:val","clear"),("w:fill",tokBg toktype)] ()
+ [ mknode "w:shd" [("w:val","clear")
+ ,("w:fill",tokBg toktype)] ()
| tokBg toktype /= "auto" ] ++
[ mknode "w:b" [] () | tokFeature tokenBold toktype ] ++
[ mknode "w:i" [] () | tokFeature tokenItalic toktype ] ++
@@ -657,10 +653,10 @@ styleToOpenXml sm style =
]
tokStyles = tokenStyles style
tokFeature f toktype = maybe False f $ M.lookup toktype tokStyles
- tokCol toktype = maybe "auto" (drop 1 . fromColor)
+ tokCol toktype = maybe "auto" (T.pack . drop 1 . fromColor)
$ (tokenColor =<< M.lookup toktype tokStyles)
`mplus` defaultColor style
- tokBg toktype = maybe "auto" (drop 1 . fromColor)
+ tokBg toktype = maybe "auto" (T.pack . drop 1 . fromColor)
$ (tokenBackground =<< M.lookup toktype tokStyles)
`mplus` backgroundColor style
parStyle | hasStyleName "Source Code" (smParaStyle sm) = Nothing
@@ -673,10 +669,11 @@ styleToOpenXml sm style =
, mknode "w:pPr" []
$ mknode "w:wordWrap" [("w:val","off")] ()
:
- maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill",drop 1 $ fromColor col)] ()]) (backgroundColor style)
+ maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill", T.pack $ drop 1 $ fromColor col)] ()]) (backgroundColor style)
]
-copyChildren :: (PandocMonad m) => Archive -> Archive -> String -> Integer -> [String] -> m Entry
+copyChildren :: (PandocMonad m)
+ => Archive -> Archive -> String -> Integer -> [Text] -> m Entry
copyChildren refArchive distArchive path timestamp elNames = do
ref <- parseXml refArchive distArchive path
dist <- parseXml distArchive distArchive path
@@ -685,7 +682,7 @@ copyChildren refArchive distArchive path timestamp elNames = do
}
where
strName QName{qName=name, qPrefix=prefix}
- | Just p <- prefix = p++":"++name
+ | Just p <- prefix = p <> ":" <> name
| otherwise = name
shouldCopy = (`elem` elNames) . strName
cleanElem el@Element{elName=name} = Elem el{elName=name{qURI=Nothing}}
@@ -706,35 +703,35 @@ maxListLevel = 8
mkNum :: ListMarker -> Int -> Element
mkNum marker numid =
- mknode "w:num" [("w:numId",show numid)]
+ mknode "w:num" [("w:numId",tshow numid)]
$ mknode "w:abstractNumId" [("w:val",listMarkerToId marker)] ()
: case marker of
NoMarker -> []
BulletMarker -> []
NumberMarker _ _ start ->
- map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",show (lvl :: Int))]
- $ mknode "w:startOverride" [("w:val",show start)] ())
+ map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",tshow (lvl :: Int))]
+ $ mknode "w:startOverride" [("w:val",tshow start)] ())
[0..maxListLevel]
mkAbstractNum :: ListMarker -> Integer -> Element
mkAbstractNum marker nsid =
mknode "w:abstractNum" [("w:abstractNumId",listMarkerToId marker)]
- $ mknode "w:nsid" [("w:val", printf "%8x" nsid)] ()
+ $ mknode "w:nsid" [("w:val", T.pack $ printf "%8x" nsid)] ()
: mknode "w:multiLevelType" [("w:val","multilevel")] ()
: map (mkLvl marker)
[0..maxListLevel]
mkLvl :: ListMarker -> Int -> Element
mkLvl marker lvl =
- mknode "w:lvl" [("w:ilvl",show lvl)] $
+ mknode "w:lvl" [("w:ilvl",tshow lvl)] $
[ mknode "w:start" [("w:val",start)] ()
| marker /= NoMarker && marker /= BulletMarker ] ++
[ mknode "w:numFmt" [("w:val",fmt)] ()
- , mknode "w:lvlText" [("w:val",lvltxt)] ()
+ , mknode "w:lvlText" [("w:val", lvltxt)] ()
, mknode "w:lvlJc" [("w:val","left")] ()
, mknode "w:pPr" []
- [ mknode "w:ind" [ ("w:left",show $ lvl * step + step)
- , ("w:hanging",show (hang :: Int))
+ [ mknode "w:ind" [ ("w:left",tshow $ lvl * step + step)
+ , ("w:hanging",tshow (hang :: Int))
] ()
]
]
@@ -743,8 +740,8 @@ mkLvl marker lvl =
NoMarker -> ("bullet"," ","1")
BulletMarker -> ("bullet",bulletFor lvl,"1")
NumberMarker st de n -> (styleFor st lvl
- ,patternFor de ("%" ++ show (lvl + 1))
- ,show n)
+ ,patternFor de ("%" <> tshow (lvl + 1))
+ ,tshow n)
step = 720
hang = 480
bulletFor 0 = "\x2022" -- filled circle
@@ -767,9 +764,9 @@ mkLvl marker lvl =
styleFor DefaultStyle 5 = "lowerRoman"
styleFor DefaultStyle x = styleFor DefaultStyle (x `mod` 6)
styleFor _ _ = "decimal"
- patternFor OneParen s = s ++ ")"
- patternFor TwoParens s = "(" ++ s ++ ")"
- patternFor _ s = s ++ "."
+ patternFor OneParen s = s <> ")"
+ patternFor TwoParens s = "(" <> s <> ")"
+ patternFor _ s = s <> "."
getNumId :: (PandocMonad m) => WS m Int
getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists
@@ -777,8 +774,8 @@ getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists
makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element]
makeTOC opts = do
- let depth = "1-"++show (writerTOCDepth opts)
- let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u"
+ let depth = "1-" <> tshow (writerTOCDepth opts)
+ let tocCmd = "TOC \\o \"" <> depth <> "\" \\h \\z \\u"
tocTitle <- gets stTocTitle
title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para tocTitle])
return
@@ -831,7 +828,7 @@ writeOpenXML opts (Pandoc meta blocks) = do
let toComment (kvs, ils) = do
annotation <- inlinesToOpenXML opts ils
return $
- mknode "w:comment" [('w':':':T.unpack k,T.unpack v) | (k,v) <- kvs]
+ mknode "w:comment" [("w:" <> k, v) | (k,v) <- kvs]
[ mknode "w:p" [] $
map Elem
[ mknode "w:pPr" []
@@ -867,24 +864,24 @@ pStyleM :: (PandocMonad m) => ParaStyleName -> WS m XML.Element
pStyleM styleName = do
pStyleMap <- gets (smParaStyle . stStyleMaps)
let sty' = getStyleIdFromName styleName pStyleMap
- return $ mknode "w:pStyle" [("w:val", T.unpack $ fromStyleId sty')] ()
+ return $ mknode "w:pStyle" [("w:val", fromStyleId sty')] ()
rStyleM :: (PandocMonad m) => CharStyleName -> WS m XML.Element
rStyleM styleName = do
cStyleMap <- gets (smCharStyle . stStyleMaps)
let sty' = getStyleIdFromName styleName cStyleMap
- return $ mknode "w:rStyle" [("w:val", T.unpack $ fromStyleId sty')] ()
+ return $ mknode "w:rStyle" [("w:val", fromStyleId sty')] ()
-getUniqueId :: (PandocMonad m) => WS m String
+getUniqueId :: (PandocMonad m) => WS m Text
-- the + 20 is to ensure that there are no clashes with the rIds
-- already in word/document.xml.rel
getUniqueId = do
n <- gets stCurId
modify $ \st -> st{stCurId = n + 1}
- return $ show n
+ return $ tshow n
-- | Key for specifying user-defined docx styles.
-dynamicStyleKey :: T.Text
+dynamicStyleKey :: Text
dynamicStyleKey = "custom-style"
-- | Convert a Pandoc block element to OpenXML.
@@ -979,7 +976,7 @@ blockToOpenXML' opts (Para lst)
blockToOpenXML' opts (LineBlock lns) = blockToOpenXML opts $ linesToPara lns
blockToOpenXML' _ b@(RawBlock format str)
| format == Format "openxml" = return [
- Text (CData CDataRaw (T.unpack str) Nothing)
+ Text (CData CDataRaw str Nothing)
]
| otherwise = do
report $ BlockNotRendered b
@@ -1036,7 +1033,7 @@ blockToOpenXML' opts (Table _ blkCapt specs thead tbody tfoot) = do
let fullrow = 5000 -- 100% specified in pct
let rowwidth = fullrow * sum widths
let mkgridcol w = mknode "w:gridCol"
- [("w:w", show (floor (textwidth * w) :: Integer))] ()
+ [("w:w", tshow (floor (textwidth * w) :: Integer))] ()
let hasHeader = not $ all null headers
modify $ \s -> s { stInTable = False }
-- for compatibility with Word <= 2007, we include a val with a bitmask
@@ -1054,16 +1051,16 @@ blockToOpenXML' opts (Table _ blkCapt specs thead tbody tfoot) = do
mknode "w:tbl" []
( mknode "w:tblPr" []
( mknode "w:tblStyle" [("w:val","Table")] () :
- mknode "w:tblW" [("w:type", "pct"), ("w:w", show rowwidth)] () :
+ mknode "w:tblW" [("w:type", "pct"), ("w:w", tshow rowwidth)] () :
mknode "w:tblLook" [("w:firstRow",if hasHeader then "1" else "0")
,("w:lastRow","0")
,("w:firstColumn","0")
,("w:lastColumn","0")
,("w:noHBand","0")
,("w:noVBand","0")
- ,("w:val", printf "%04x" tblLookVal)
+ ,("w:val", T.pack $ printf "%04x" tblLookVal)
] () :
- [ mknode "w:tblCaption" [("w:val", T.unpack captionStr)] ()
+ [ mknode "w:tblCaption" [("w:val", captionStr)] ()
| not (null caption) ] )
: mknode "w:tblGrid" []
(if all (==0) widths
@@ -1126,7 +1123,7 @@ listItemToOpenXML opts numid (first:rest) = do
modify $ \st -> st{ stInList = oldInList }
return $ first'' ++ rest''
-alignmentToString :: Alignment -> [Char]
+alignmentToString :: Alignment -> Text
alignmentToString alignment = case alignment of
AlignLeft -> "left"
AlignRight -> "right"
@@ -1169,8 +1166,8 @@ getParaProps displayMathPara = do
listLevel <- asks envListLevel
numid <- asks envListNumId
let listPr = [mknode "w:numPr" []
- [ mknode "w:ilvl" [("w:val",show listLevel)] ()
- , mknode "w:numId" [("w:val",show numid)] () ] | listLevel >= 0 && not displayMathPara]
+ [ mknode "w:ilvl" [("w:val",tshow listLevel)] ()
+ , mknode "w:numId" [("w:val",tshow numid)] () ] | listLevel >= 0 && not displayMathPara]
return $ case listPr ++ squashProps props of
[] -> []
ps -> [mknode "w:pPr" [] ps]
@@ -1185,7 +1182,7 @@ withParaPropM md p = do
d <- md
withParaProp d p
-formattedString :: PandocMonad m => T.Text -> WS m [Element]
+formattedString :: PandocMonad m => Text -> WS m [Element]
formattedString str =
-- properly handle soft hyphens
case splitTextBy (=='\173') str of
@@ -1194,7 +1191,7 @@ formattedString str =
sh <- formattedRun [mknode "w:softHyphen" [] ()]
intercalate sh <$> mapM formattedString' ws
-formattedString' :: PandocMonad m => T.Text -> WS m [Element]
+formattedString' :: PandocMonad m => Text -> WS m [Element]
formattedString' str = do
inDel <- asks envInDel
formattedRun [ mktnode (if inDel then "w:delText" else "w:t")
@@ -1226,7 +1223,7 @@ inlineToOpenXML' opts (Span ("",["csl-right-inline"],[]) ils) =
mknode "w:r" []
(mknode "w:t"
[("xml:space","preserve")]
- ("\t" :: String))] ++)
+ ("\t" :: Text))] ++)
<$> inlinesToOpenXML opts ils
inlineToOpenXML' opts (Span ("",["csl-indent"],[]) ils) =
inlinesToOpenXML opts ils
@@ -1236,17 +1233,17 @@ inlineToOpenXML' _ (Span (ident,["comment-start"],kvs) ils) = do
let ident' = fromMaybe ident (lookup "id" kvs)
kvs' = filter (("id" /=) . fst) kvs
modify $ \st -> st{ stComments = (("id",ident'):kvs', ils) : stComments st }
- return [ Elem $ mknode "w:commentRangeStart" [("w:id", T.unpack ident')] () ]
+ return [ Elem $ mknode "w:commentRangeStart" [("w:id", ident')] () ]
inlineToOpenXML' _ (Span (ident,["comment-end"],kvs) _) =
-- prefer the "id" in kvs, since that is the one produced by the docx
-- reader.
let ident' = fromMaybe ident (lookup "id" kvs)
in return . map Elem $
- [ mknode "w:commentRangeEnd" [("w:id", T.unpack ident')] ()
+ [ mknode "w:commentRangeEnd" [("w:id", ident')] ()
, mknode "w:r" []
[ mknode "w:rPr" []
[ mknode "w:rStyle" [("w:val", "CommentReference")] () ]
- , mknode "w:commentReference" [("w:id", T.unpack ident')] () ]
+ , mknode "w:commentReference" [("w:id", ident')] () ]
]
inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do
stylemod <- case lookup dynamicStyleKey kvs of
@@ -1270,8 +1267,8 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do
defaultAuthor <- asks envChangesAuthor
let author = fromMaybe defaultAuthor (lookup "author" kvs)
let mdate = lookup "date" kvs
- return $ ("w:author", T.unpack author) :
- maybe [] (\date -> [("w:date", T.unpack date)]) mdate
+ return $ ("w:author", author) :
+ maybe [] (\date -> [("w:date", date)]) mdate
insmod <- if "insertion" `elem` classes
then do
changeAuthorDate <- getChangeAuthorDate
@@ -1281,7 +1278,7 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do
x <- f
return [Elem $
mknode "w:ins"
- (("w:id", show insId) : changeAuthorDate) x]
+ (("w:id", tshow insId) : changeAuthorDate) x]
else return id
delmod <- if "deletion" `elem` classes
then do
@@ -1291,7 +1288,7 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do
return $ \f -> local (\env->env{envInDel=True}) $ do
x <- f
return [Elem $ mknode "w:del"
- (("w:id", show delId) : changeAuthorDate) x]
+ (("w:id", tshow delId) : changeAuthorDate) x]
else return id
contents <- insmod $ delmod $ dirmod $ stylemod $ pmod
$ inlinesToOpenXML opts ils
@@ -1322,7 +1319,7 @@ inlineToOpenXML' opts (Strikeout lst) =
inlineToOpenXML' _ LineBreak = return [Elem br]
inlineToOpenXML' _ il@(RawInline f str)
| f == Format "openxml" = return
- [Text (CData CDataRaw (T.unpack str) Nothing)]
+ [Text (CData CDataRaw str Nothing)]
| otherwise = do
report $ InlineNotRendered il
return []
@@ -1335,7 +1332,7 @@ inlineToOpenXML' opts (Math mathType str) = do
when (mathType == DisplayMath) setFirstPara
res <- (lift . lift) (convertMath writeOMML mathType str)
case res of
- Right r -> return [Elem r]
+ Right r -> return [Elem $ fromXLElement r]
Left il -> inlineToOpenXML' opts il
inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst
inlineToOpenXML' opts (Code attrs str) = do
@@ -1348,7 +1345,7 @@ inlineToOpenXML' opts (Code attrs str) = do
mknode "w:r" []
[ mknode "w:rPr" [] $
maybeToList (lookup toktype tokTypesMap)
- , mknode "w:t" [("xml:space","preserve")] (T.unpack tok) ]
+ , mknode "w:t" [("xml:space","preserve")] tok ]
withTextPropM (rStyleM "Verbatim Char")
$ if isNothing (writerHighlightStyle opts)
then unhighlighted
@@ -1365,7 +1362,7 @@ inlineToOpenXML' opts (Note bs) = do
let notemarker = mknode "w:r" []
[ mknode "w:rPr" [] footnoteStyle
, mknode "w:footnoteRef" [] () ]
- let notemarkerXml = RawInline (Format "openxml") $ T.pack $ ppElement notemarker
+ let notemarkerXml = RawInline (Format "openxml") $ ppElement notemarker
let insertNoteRef (Plain ils : xs) = Plain (notemarkerXml : Space : ils) : xs
insertNoteRef (Para ils : xs) = Para (notemarkerXml : Space : ils) : xs
insertNoteRef xs = Para [notemarkerXml] : xs
@@ -1384,17 +1381,17 @@ inlineToOpenXML' opts (Note bs) = do
inlineToOpenXML' opts (Link _ txt (T.uncons -> Just ('#', xs),_)) = do
contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt
return
- [ Elem $ mknode "w:hyperlink" [("w:anchor", T.unpack $ toBookmarkName xs)] contents ]
+ [ Elem $ mknode "w:hyperlink" [("w:anchor", toBookmarkName xs)] contents ]
-- external link:
inlineToOpenXML' opts (Link _ txt (src,_)) = do
contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt
extlinks <- gets stExternalLinks
- id' <- case M.lookup (T.unpack src) extlinks of
+ id' <- case M.lookup src extlinks of
Just i -> return i
Nothing -> do
- i <- ("rId"++) `fmap` getUniqueId
+ i <- ("rId" <>) <$> getUniqueId
modify $ \st -> st{ stExternalLinks =
- M.insert (T.unpack src) i extlinks }
+ M.insert src i extlinks }
return i
return [ Elem $ mknode "w:hyperlink" [("r:id",id')] contents ]
inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
@@ -1414,17 +1411,17 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
,("noChangeAspect","1")] ()
nvPicPr = mknode "pic:nvPicPr" []
[ mknode "pic:cNvPr"
- [("descr",T.unpack src),("id","0"),("name","Picture")] ()
+ [("descr",src),("id","0"),("name","Picture")] ()
, cNvPicPr ]
blipFill = mknode "pic:blipFill" []
- [ mknode "a:blip" [("r:embed",ident)] ()
+ [ mknode "a:blip" [("r:embed",T.pack ident)] ()
, mknode "a:stretch" [] $
mknode "a:fillRect" [] ()
]
xfrm = mknode "a:xfrm" []
[ mknode "a:off" [("x","0"),("y","0")] ()
- , mknode "a:ext" [("cx",show xemu)
- ,("cy",show yemu)] () ]
+ , mknode "a:ext" [("cx",tshow xemu)
+ ,("cy",tshow yemu)] () ]
prstGeom = mknode "a:prstGeom" [("prst","rect")] $
mknode "a:avLst" [] ()
ln = mknode "a:ln" [("w","9525")]
@@ -1445,12 +1442,12 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
imgElt = mknode "w:r" [] $
mknode "w:drawing" [] $
mknode "wp:inline" []
- [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()
+ [ mknode "wp:extent" [("cx",tshow xemu),("cy",tshow yemu)] ()
, mknode "wp:effectExtent"
[("b","0"),("l","0"),("r","0"),("t","0")] ()
, mknode "wp:docPr"
- [ ("descr", T.unpack $ stringify alt)
- , ("title", T.unpack title)
+ [ ("descr", stringify alt)
+ , ("title", title)
, ("id","1")
, ("name","Picture")
] ()
@@ -1463,7 +1460,7 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
Just imgData -> return [Elem $ generateImgElt imgData]
Nothing -> ( do --try
(img, mt) <- P.fetchItem src
- ident <- ("rId"++) `fmap` getUniqueId
+ ident <- ("rId" <>) <$> getUniqueId
let
imgext = case mt >>= extensionFromMimeType of
@@ -1477,10 +1474,10 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
Just Svg -> ".svg"
Just Emf -> ".emf"
Nothing -> ""
- imgpath = "media/" <> ident <> T.unpack imgext
- mbMimeType = mt <|> getMimeType imgpath
+ imgpath = "media/" <> ident <> imgext
+ mbMimeType = mt <|> getMimeType (T.unpack imgpath)
- imgData = (ident, imgpath, mbMimeType, img)
+ imgData = (T.unpack ident, T.unpack imgpath, mbMimeType, img)
if T.null imgext
then -- without an extension there is no rule for content type
@@ -1538,20 +1535,20 @@ withDirection x = do
, envTextProperties = EnvProps textStyle textProps'
}
-wrapBookmark :: (PandocMonad m) => T.Text -> [Content] -> WS m [Content]
+wrapBookmark :: (PandocMonad m) => Text -> [Content] -> WS m [Content]
wrapBookmark "" contents = return contents
wrapBookmark ident contents = do
id' <- getUniqueId
let bookmarkStart = mknode "w:bookmarkStart"
[("w:id", id')
- ,("w:name", T.unpack $ toBookmarkName ident)] ()
+ ,("w:name", toBookmarkName ident)] ()
bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()
return $ Elem bookmarkStart : contents ++ [Elem bookmarkEnd]
-- Word imposes a 40 character limit on bookmark names and requires
-- that they begin with a letter. So we just use a hash of the
-- identifier when otherwise we'd have an illegal bookmark name.
-toBookmarkName :: T.Text -> T.Text
+toBookmarkName :: Text -> Text
toBookmarkName s
| Just (c, _) <- T.uncons s
, isLetter c
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 171ffe582..3f10cb437 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -24,12 +24,13 @@ import Control.Monad.State.Strict (StateT, evalState, evalStateT, get,
gets, lift, modify)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as B8
-import Data.Char (isAlphaNum, isAscii, isDigit, toLower)
+import Data.Char (isAlphaNum, isAscii, isDigit)
import Data.List (isInfixOf, isPrefixOf)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing, mapMaybe, isJust)
import qualified Data.Set as Set
-import qualified Data.Text as TS
+import qualified Data.Text as T
+import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import Network.HTTP (urlEncode)
import System.FilePath (takeExtension, takeFileName, makeRelative)
@@ -48,16 +49,13 @@ import Text.Pandoc.Options (EPUBVersion (..), HTMLMathMethod (..),
ObfuscationMethod (NoObfuscation), WrapOption (..),
WriterOptions (..))
import Text.Pandoc.Shared (makeSections, normalizeDate, renderTags',
- safeRead, stringify, trim, uniqueIdent, tshow)
+ stringify, uniqueIdent, tshow)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.UUID (getRandomUUID)
import Text.Pandoc.Walk (query, walk, walkM)
import Text.Pandoc.Writers.HTML (writeHtmlStringForEPUB)
import Text.Printf (printf)
-import Text.XML.Light (Attr (..), Element (..), Node (..), QName (..),
- add_attrs, lookupAttr, node, onlyElems,
- ppElement, showElement, strContent, unode, unqual)
-import Text.Pandoc.XMLParser (parseXMLContents)
+import Text.Pandoc.XML.Light
import Text.Pandoc.XML (escapeStringForXML)
import Text.DocTemplates (FromContext(lookupContext), Context(..),
ToContext(toVal), Val(..))
@@ -69,7 +67,7 @@ newtype Chapter = Chapter [Block]
data EPUBState = EPUBState {
stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]
, stMediaNextId :: Int
- , stEpubSubdir :: String
+ , stEpubSubdir :: FilePath
}
type E m = StateT EPUBState m
@@ -78,62 +76,63 @@ data EPUBMetadata = EPUBMetadata{
epubIdentifier :: [Identifier]
, epubTitle :: [Title]
, epubDate :: [Date]
- , epubLanguage :: String
+ , epubLanguage :: Text
, epubCreator :: [Creator]
, epubContributor :: [Creator]
- , epubSubject :: [String]
- , epubDescription :: Maybe String
- , epubType :: Maybe String
- , epubFormat :: Maybe String
- , epubPublisher :: Maybe String
- , epubSource :: Maybe String
- , epubRelation :: Maybe String
- , epubCoverage :: Maybe String
- , epubRights :: Maybe String
- , epubBelongsToCollection :: Maybe String
- , epubGroupPosition :: Maybe String
- , epubCoverImage :: Maybe String
+ , epubSubject :: [Text]
+ , epubDescription :: Maybe Text
+ , epubType :: Maybe Text
+ , epubFormat :: Maybe Text
+ , epubPublisher :: Maybe Text
+ , epubSource :: Maybe Text
+ , epubRelation :: Maybe Text
+ , epubCoverage :: Maybe Text
+ , epubRights :: Maybe Text
+ , epubBelongsToCollection :: Maybe Text
+ , epubGroupPosition :: Maybe Text
+ , epubCoverImage :: Maybe FilePath
, epubStylesheets :: [FilePath]
, epubPageDirection :: Maybe ProgressionDirection
- , epubIbooksFields :: [(String, String)]
- , epubCalibreFields :: [(String, String)]
+ , epubIbooksFields :: [(Text, Text)]
+ , epubCalibreFields :: [(Text, Text)]
} deriving Show
data Date = Date{
- dateText :: String
- , dateEvent :: Maybe String
+ dateText :: Text
+ , dateEvent :: Maybe Text
} deriving Show
data Creator = Creator{
- creatorText :: String
- , creatorRole :: Maybe String
- , creatorFileAs :: Maybe String
+ creatorText :: Text
+ , creatorRole :: Maybe Text
+ , creatorFileAs :: Maybe Text
} deriving Show
data Identifier = Identifier{
- identifierText :: String
- , identifierScheme :: Maybe String
+ identifierText :: Text
+ , identifierScheme :: Maybe Text
} deriving Show
data Title = Title{
- titleText :: String
- , titleFileAs :: Maybe String
- , titleType :: Maybe String
+ titleText :: Text
+ , titleFileAs :: Maybe Text
+ , titleType :: Maybe Text
} deriving Show
data ProgressionDirection = LTR | RTL deriving Show
-dcName :: String -> QName
+dcName :: Text -> QName
dcName n = QName n Nothing (Just "dc")
-dcNode :: Node t => String -> t -> Element
+dcNode :: Node t => Text -> t -> Element
dcNode = node . dcName
-opfName :: String -> QName
+opfName :: Text -> QName
opfName n = QName n Nothing (Just "opf")
-toId :: FilePath -> String
-toId = map (\x -> if isAlphaNum x || x == '-' || x == '_'
+toId :: FilePath -> Text
+toId = T.pack .
+ map (\x -> if isAlphaNum x || x == '-' || x == '_'
then x
else '_') . takeFileName
@@ -141,8 +140,8 @@ removeNote :: Inline -> Inline
removeNote (Note _) = Str ""
removeNote x = x
-toVal' :: String -> Val TS.Text
-toVal' = toVal . TS.pack
+toVal' :: Text -> Val T.Text
+toVal' = toVal
mkEntry :: PandocMonad m => FilePath -> B.ByteString -> E m Entry
mkEntry path content = do
@@ -172,21 +171,21 @@ getEPUBMetadata opts meta = do
if null (epubIdentifier m)
then do
randomId <- getRandomUUID
- return $ m{ epubIdentifier = [Identifier (show randomId) Nothing] }
+ return $ m{ epubIdentifier = [Identifier (tshow randomId) Nothing] }
else return m
let addLanguage m =
- if null (epubLanguage m)
+ if T.null (epubLanguage m)
then case lookupContext "lang" (writerVariables opts) of
- Just x -> return m{ epubLanguage = TS.unpack x }
+ Just x -> return m{ epubLanguage = x }
Nothing -> do
mLang <- lift $ P.lookupEnv "LANG"
let localeLang =
case mLang of
Just lang ->
- TS.map (\c -> if c == '_' then '-' else c) $
- TS.takeWhile (/='.') lang
+ T.map (\c -> if c == '_' then '-' else c) $
+ T.takeWhile (/='.') lang
Nothing -> "en-US"
- return m{ epubLanguage = TS.unpack localeLang }
+ return m{ epubLanguage = localeLang }
else return m
let fixDate m =
if null (epubDate m)
@@ -201,7 +200,7 @@ getEPUBMetadata opts meta = do
then return m
else do
let authors' = map stringify $ docAuthors meta
- let toAuthor name = Creator{ creatorText = TS.unpack name
+ let toAuthor name = Creator{ creatorText = name
, creatorRole = Just "aut"
, creatorFileAs = Nothing }
return $ m{ epubCreator = map toAuthor authors' ++ epubCreator m }
@@ -249,31 +248,31 @@ addMetadataFromXML e@(Element (QName name _ (Just "dc")) attrs _ _) md
where getAttr n = lookupAttr (opfName n) attrs
addMetadataFromXML e@(Element (QName "meta" _ _) attrs _ _) md =
case getAttr "property" of
- Just s | "ibooks:" `isPrefixOf` s ->
- md{ epubIbooksFields = (drop 7 s, strContent e) :
+ Just s | "ibooks:" `T.isPrefixOf` s ->
+ md{ epubIbooksFields = (T.drop 7 s, strContent e) :
epubIbooksFields md }
_ -> case getAttr "name" of
- Just s | "calibre:" `isPrefixOf` s ->
+ Just s | "calibre:" `T.isPrefixOf` s ->
md{ epubCalibreFields =
- (drop 8 s, fromMaybe "" $ getAttr "content") :
+ (T.drop 8 s, fromMaybe "" $ getAttr "content") :
epubCalibreFields md }
_ -> md
where getAttr n = lookupAttr (unqual n) attrs
addMetadataFromXML _ md = md
-metaValueToString :: MetaValue -> String
-metaValueToString (MetaString s) = TS.unpack s
-metaValueToString (MetaInlines ils) = TS.unpack $ stringify ils
-metaValueToString (MetaBlocks bs) = TS.unpack $ stringify bs
+metaValueToString :: MetaValue -> Text
+metaValueToString (MetaString s) = s
+metaValueToString (MetaInlines ils) = stringify ils
+metaValueToString (MetaBlocks bs) = stringify bs
metaValueToString (MetaBool True) = "true"
metaValueToString (MetaBool False) = "false"
metaValueToString _ = ""
metaValueToPaths :: MetaValue -> [FilePath]
-metaValueToPaths (MetaList xs) = map metaValueToString xs
-metaValueToPaths x = [metaValueToString x]
+metaValueToPaths (MetaList xs) = map (T.unpack . metaValueToString) xs
+metaValueToPaths x = [T.unpack $ metaValueToString x]
-getList :: TS.Text -> Meta -> (MetaValue -> a) -> [a]
+getList :: T.Text -> Meta -> (MetaValue -> a) -> [a]
getList s meta handleMetaValue =
case lookupMeta s meta of
Just (MetaList xs) -> map handleMetaValue xs
@@ -297,7 +296,7 @@ getTitle meta = getList "title" meta handleMetaValue
, titleType = metaValueToString <$> M.lookup "type" m }
handleMetaValue mv = Title (metaValueToString mv) Nothing Nothing
-getCreator :: TS.Text -> Meta -> [Creator]
+getCreator :: T.Text -> Meta -> [Creator]
getCreator s meta = getList s meta handleMetaValue
where handleMetaValue (MetaMap m) =
Creator{ creatorText = maybe "" metaValueToString $ M.lookup "text" m
@@ -305,7 +304,7 @@ getCreator s meta = getList s meta handleMetaValue
, creatorRole = metaValueToString <$> M.lookup "role" m }
handleMetaValue mv = Creator (metaValueToString mv) Nothing Nothing
-getDate :: TS.Text -> Meta -> [Date]
+getDate :: T.Text -> Meta -> [Date]
getDate s meta = getList s meta handleMetaValue
where handleMetaValue (MetaMap m) =
Date{ dateText = fromMaybe "" $
@@ -314,7 +313,7 @@ getDate s meta = getList s meta handleMetaValue
handleMetaValue mv = Date { dateText = fromMaybe "" $ normalizeDate' $ metaValueToString mv
, dateEvent = Nothing }
-simpleList :: TS.Text -> Meta -> [String]
+simpleList :: T.Text -> Meta -> [Text]
simpleList s meta =
case lookupMeta s meta of
Just (MetaList xs) -> map metaValueToString xs
@@ -339,7 +338,7 @@ metadataFromMeta opts meta = EPUBMetadata{
, epubCoverage = coverage
, epubRights = rights
, epubBelongsToCollection = belongsToCollection
- , epubGroupPosition = groupPosition
+ , epubGroupPosition = groupPosition
, epubCoverImage = coverImage
, epubStylesheets = stylesheets
, epubPageDirection = pageDirection
@@ -363,31 +362,30 @@ metadataFromMeta opts meta = EPUBMetadata{
coverage = metaValueToString <$> lookupMeta "coverage" meta
rights = metaValueToString <$> lookupMeta "rights" meta
belongsToCollection = metaValueToString <$> lookupMeta "belongs-to-collection" meta
- groupPosition = metaValueToString <$> lookupMeta "group-position" meta
- coverImage =
- (TS.unpack <$> lookupContext "epub-cover-image"
- (writerVariables opts))
+ groupPosition = metaValueToString <$> lookupMeta "group-position" meta
+ coverImage = T.unpack <$>
+ lookupContext "epub-cover-image" (writerVariables opts)
`mplus` (metaValueToString <$> lookupMeta "cover-image" meta)
mCss = lookupMeta "css" meta <|> lookupMeta "stylesheet" meta
stylesheets = maybe [] metaValueToPaths mCss ++
case lookupContext "css" (writerVariables opts) of
- Just xs -> map TS.unpack xs
+ Just xs -> map T.unpack xs
Nothing ->
case lookupContext "css" (writerVariables opts) of
- Just x -> [TS.unpack x]
+ Just x -> [T.unpack x]
Nothing -> []
- pageDirection = case map toLower . metaValueToString <$>
+ pageDirection = case T.toLower . metaValueToString <$>
lookupMeta "page-progression-direction" meta of
Just "ltr" -> Just LTR
Just "rtl" -> Just RTL
_ -> Nothing
ibooksFields = case lookupMeta "ibooks" meta of
Just (MetaMap mp)
- -> M.toList $ M.mapKeys TS.unpack $ M.map metaValueToString mp
+ -> M.toList $ M.map metaValueToString mp
_ -> []
calibreFields = case lookupMeta "calibre" meta of
Just (MetaMap mp)
- -> M.toList $ M.mapKeys TS.unpack $ M.map metaValueToString mp
+ -> M.toList $ M.map metaValueToString mp
_ -> []
-- | Produce an EPUB2 file from a Pandoc document.
@@ -413,9 +411,11 @@ writeEPUB :: PandocMonad m
writeEPUB epubVersion opts doc = do
let epubSubdir = writerEpubSubdirectory opts
-- sanity check on epubSubdir
- unless (TS.all (\c -> isAscii c && isAlphaNum c) epubSubdir) $
+ unless (T.all (\c -> isAscii c && isAlphaNum c) epubSubdir) $
throwError $ PandocEpubSubdirectoryError epubSubdir
- let initState = EPUBState { stMediaPaths = [], stMediaNextId = 0, stEpubSubdir = TS.unpack epubSubdir }
+ let initState = EPUBState { stMediaPaths = []
+ , stMediaNextId = 0
+ , stEpubSubdir = T.unpack epubSubdir }
evalStateT (pandocToEPUB epubVersion opts doc) initState
pandocToEPUB :: PandocMonad m
@@ -439,7 +439,7 @@ pandocToEPUB version opts doc = do
[] -> case epubTitle metadata of
[] -> "UNTITLED"
(x:_) -> titleText x
- x -> TS.unpack $ stringify x
+ x -> stringify x
-- stylesheet
stylesheets <- case epubStylesheets metadata of
@@ -461,7 +461,8 @@ pandocToEPUB version opts doc = do
(ListVal $ map
(\e -> toVal' $
(if useprefix then "../" else "") <>
- makeRelative epubSubdir (eRelativePath e))
+ T.pack
+ (makeRelative epubSubdir (eRelativePath e)))
stylesheetEntries)
mempty
@@ -490,18 +491,19 @@ pandocToEPUB version opts doc = do
case imageSize opts' (B.toStrict imgContent) of
Right sz -> return $ sizeInPixels sz
Left err' -> (0, 0) <$ report
- (CouldNotDetermineImageSize (TS.pack img) err')
+ (CouldNotDetermineImageSize (T.pack img) err')
cpContent <- lift $ writeHtml
opts'{ writerVariables =
Context (M.fromList [
("coverpage", toVal' "true"),
("pagetitle", toVal $
- escapeStringForXML $ TS.pack plainTitle),
- ("cover-image", toVal' coverImageName),
+ escapeStringForXML plainTitle),
+ ("cover-image",
+ toVal' $ T.pack coverImageName),
("cover-image-width", toVal' $
- show coverImageWidth),
+ tshow coverImageWidth),
("cover-image-height", toVal' $
- show coverImageHeight)]) <>
+ tshow coverImageHeight)]) <>
cssvars True <> vars }
(Pandoc meta [])
coverEntry <- mkEntry "text/cover.xhtml" cpContent
@@ -517,7 +519,7 @@ pandocToEPUB version opts doc = do
("titlepage", toVal' "true"),
("body-type", toVal' "frontmatter"),
("pagetitle", toVal $
- escapeStringForXML $ TS.pack plainTitle)])
+ escapeStringForXML plainTitle)])
<> cssvars True <> vars }
(Pandoc meta [])
tpEntry <- mkEntry "text/title_page.xhtml" tpContent
@@ -526,7 +528,7 @@ pandocToEPUB version opts doc = do
let matchingGlob f = do
xs <- lift $ P.glob f
when (null xs) $
- report $ CouldNotFetchResource (TS.pack f) "glob did not match any font files"
+ report $ CouldNotFetchResource (T.pack f) "glob did not match any font files"
return xs
let mkFontEntry f = mkEntry ("fonts/" ++ takeFileName f) =<<
lift (P.readFileLazy f)
@@ -573,13 +575,13 @@ pandocToEPUB version opts doc = do
let chapters' = secsToChapters secs
- let extractLinkURL' :: Int -> Inline -> [(TS.Text, TS.Text)]
+ let extractLinkURL' :: Int -> Inline -> [(T.Text, T.Text)]
extractLinkURL' num (Span (ident, _, _) _)
- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]
+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)]
extractLinkURL' num (Link (ident, _, _) _ _)
- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]
+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)]
extractLinkURL' num (Image (ident, _, _) _ _)
- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]
+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)]
extractLinkURL' num (RawInline fmt raw)
| isHtmlFormat fmt
= foldr (\tag ->
@@ -587,18 +589,18 @@ pandocToEPUB version opts doc = do
TagOpen{} ->
case fromAttrib "id" tag of
"" -> id
- x -> ((x, TS.pack (showChapter num) <> "#" <> x):)
+ x -> ((x, showChapter num <> "#" <> x):)
_ -> id)
[] (parseTags raw)
extractLinkURL' _ _ = []
- let extractLinkURL :: Int -> Block -> [(TS.Text, TS.Text)]
+ let extractLinkURL :: Int -> Block -> [(T.Text, T.Text)]
extractLinkURL num (Div (ident, _, _) _)
- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]
+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)]
extractLinkURL num (Header _ (ident, _, _) _)
- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]
+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)]
extractLinkURL num (Table (ident,_,_) _ _ _ _ _)
- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]
+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)]
extractLinkURL num (RawBlock fmt raw)
| isHtmlFormat fmt
= foldr (\tag ->
@@ -606,7 +608,7 @@ pandocToEPUB version opts doc = do
TagOpen{} ->
case fromAttrib "id" tag of
"" -> id
- x -> ((x, TS.pack (showChapter num) <> "#" <> x):)
+ x -> ((x, showChapter num <> "#" <> x):)
_ -> id)
[] (parseTags raw)
extractLinkURL num b = query (extractLinkURL' num) b
@@ -617,7 +619,7 @@ pandocToEPUB version opts doc = do
let fixInternalReferences :: Inline -> Inline
fixInternalReferences (Link attr lab (src, tit))
- | Just ('#', xs) <- TS.uncons src = case lookup xs reftable of
+ | Just ('#', xs) <- T.uncons src = case lookup xs reftable of
Just ys -> Link attr lab (ys, tit)
Nothing -> Link attr lab (src, tit)
fixInternalReferences x = x
@@ -630,7 +632,7 @@ pandocToEPUB version opts doc = do
chapters'
let chapToEntry num (Chapter bs) =
- mkEntry ("text/" ++ showChapter num) =<<
+ mkEntry ("text/" ++ T.unpack (showChapter num)) =<<
writeHtml opts'{ writerVariables =
Context (M.fromList
[("body-type", toVal' bodyType),
@@ -677,12 +679,12 @@ pandocToEPUB version opts doc = do
let chapterNode ent = unode "item" !
([("id", toId $ makeRelative epubSubdir
$ eRelativePath ent),
- ("href", makeRelative epubSubdir
+ ("href", T.pack $ makeRelative epubSubdir
$ eRelativePath ent),
("media-type", "application/xhtml+xml")]
++ case props ent of
[] -> []
- xs -> [("properties", unwords xs)])
+ xs -> [("properties", T.unwords xs)])
$ ()
let chapterRefNode ent = unode "itemref" !
@@ -691,17 +693,17 @@ pandocToEPUB version opts doc = do
let pictureNode ent = unode "item" !
[("id", toId $ makeRelative epubSubdir
$ eRelativePath ent),
- ("href", makeRelative epubSubdir
+ ("href", T.pack $ makeRelative epubSubdir
$ eRelativePath ent),
("media-type",
- maybe "application/octet-stream" TS.unpack
+ fromMaybe "application/octet-stream"
$ mediaTypeOf $ eRelativePath ent)] $ ()
let fontNode ent = unode "item" !
[("id", toId $ makeRelative epubSubdir
$ eRelativePath ent),
- ("href", makeRelative epubSubdir
+ ("href", T.pack $ makeRelative epubSubdir
$ eRelativePath ent),
- ("media-type", maybe "" TS.unpack $
+ ("media-type", fromMaybe "" $
getMimeType $ eRelativePath ent)] $ ()
let tocTitle = maybe plainTitle
@@ -710,7 +712,7 @@ pandocToEPUB version opts doc = do
(x:_) -> return $ identifierText x -- use first identifier as UUID
[] -> throwError $ PandocShouldNeverHappenError "epubIdentifier is null" -- shouldn't happen
currentTime <- lift P.getTimestamp
- let contentsData = UTF8.fromStringLazy $ ppTopElement $
+ let contentsData = UTF8.fromTextLazy $ TL.fromStrict $ ppTopElement $
unode "package" !
([("version", case version of
EPUB2 -> "2.0"
@@ -728,7 +730,8 @@ pandocToEPUB version opts doc = do
,("media-type","application/xhtml+xml")] ++
[("properties","nav") | epub3 ]) $ ()
] ++
- [ unode "item" ! [("id","stylesheet" ++ show n), ("href",fp)
+ [ unode "item" ! [("id","stylesheet" <> tshow n)
+ , ("href", T.pack fp)
,("media-type","text/css")] $ () |
(n :: Int, fp) <- zip [1..] (map
(makeRelative epubSubdir . eRelativePath)
@@ -773,7 +776,7 @@ pandocToEPUB version opts doc = do
let tocLevel = writerTOCDepth opts
let navPointNode :: PandocMonad m
- => (Int -> [Inline] -> TS.Text -> [Element] -> Element)
+ => (Int -> [Inline] -> T.Text -> [Element] -> Element)
-> Block -> StateT Int m [Element]
navPointNode formatter (Div (ident,_,_)
(Header lvl (_,_,kvs) ils : children)) =
@@ -783,7 +786,7 @@ pandocToEPUB version opts doc = do
n <- get
modify (+1)
let num = fromMaybe "" $ lookup "number" kvs
- let tit = if writerNumberSections opts && not (TS.null num)
+ let tit = if writerNumberSections opts && not (T.null num)
then Span ("", ["section-header-number"], [])
[Str num] : Space : ils
else ils
@@ -797,21 +800,21 @@ pandocToEPUB version opts doc = do
concat <$> mapM (navPointNode formatter) bs
navPointNode _ _ = return []
- let navMapFormatter :: Int -> [Inline] -> TS.Text -> [Element] -> Element
+ let navMapFormatter :: Int -> [Inline] -> T.Text -> [Element] -> Element
navMapFormatter n tit src subs = unode "navPoint" !
- [("id", "navPoint-" ++ show n)] $
- [ unode "navLabel" $ unode "text" $ TS.unpack $ stringify tit
- , unode "content" ! [("src", "text/" <> TS.unpack src)] $ ()
+ [("id", "navPoint-" <> tshow n)] $
+ [ unode "navLabel" $ unode "text" $ stringify tit
+ , unode "content" ! [("src", "text/" <> src)] $ ()
] ++ subs
let tpNode = unode "navPoint" ! [("id", "navPoint-0")] $
- [ unode "navLabel" $ unode "text" (TS.unpack $ stringify $ docTitle' meta)
+ [ unode "navLabel" $ unode "text" (stringify $ docTitle' meta)
, unode "content" ! [("src", "text/title_page.xhtml")]
$ () ]
navMap <- lift $ evalStateT
(concat <$> mapM (navPointNode navMapFormatter) secs) 1
- let tocData = UTF8.fromStringLazy $ ppTopElement $
+ let tocData = B.fromStrict $ UTF8.fromText $ ppTopElement $
unode "ncx" ! [("version","2005-1")
,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $
[ unode "head" $
@@ -833,11 +836,11 @@ pandocToEPUB version opts doc = do
]
tocEntry <- mkEntry "toc.ncx" tocData
- let navXhtmlFormatter :: Int -> [Inline] -> TS.Text -> [Element] -> Element
+ let navXhtmlFormatter :: Int -> [Inline] -> T.Text -> [Element] -> Element
navXhtmlFormatter n tit src subs = unode "li" !
- [("id", "toc-li-" ++ show n)] $
+ [("id", "toc-li-" <> tshow n)] $
(unode "a" !
- [("href", "text/" <> TS.unpack src)]
+ [("href", "text/" <> src)]
$ titElements)
: case subs of
[] -> []
@@ -850,7 +853,7 @@ pandocToEPUB version opts doc = do
, writerVariables =
Context (M.fromList
[("pagetitle", toVal $
- escapeStringForXML $ TS.pack plainTitle)])
+ escapeStringForXML plainTitle)])
<> writerVariables opts}
(Pandoc nullMeta
[Plain $ walk clean tit])) of
@@ -865,7 +868,7 @@ pandocToEPUB version opts doc = do
tocBlocks <- lift $ evalStateT
(concat <$> mapM (navPointNode navXhtmlFormatter) secs) 1
let navBlocks = [RawBlock (Format "html")
- $ TS.pack $ showElement $ -- prettyprinting introduces bad spaces
+ $ showElement $ -- prettyprinting introduces bad spaces
unode navtag ! ([("epub:type","toc") | epub3] ++
[("id","toc")]) $
[ unode "h1" ! [("id","toc-title")] $ tocTitle
@@ -875,21 +878,21 @@ pandocToEPUB version opts doc = do
[ unode "a" ! [("href",
"text/title_page.xhtml")
,("epub:type", "titlepage")] $
- ("Title Page" :: String) ] :
+ ("Title Page" :: Text) ] :
[ unode "li"
[ unode "a" ! [("href", "text/cover.xhtml")
,("epub:type", "cover")] $
- ("Cover" :: String)] |
+ ("Cover" :: Text)] |
isJust (epubCoverImage metadata)
] ++
[ unode "li"
[ unode "a" ! [("href", "#toc")
,("epub:type", "toc")] $
- ("Table of Contents" :: String)
+ ("Table of Contents" :: Text)
] | writerTableOfContents opts
]
else []
- let landmarks = [RawBlock (Format "html") $ TS.pack $ ppElement $
+ let landmarks = [RawBlock (Format "html") $ ppElement $
unode "nav" ! [("epub:type","landmarks")
,("id","landmarks")
,("hidden","hidden")] $
@@ -910,22 +913,22 @@ pandocToEPUB version opts doc = do
UTF8.fromStringLazy "application/epub+zip"
-- container.xml
- let containerData = UTF8.fromStringLazy $ ppTopElement $
+ let containerData = B.fromStrict $ UTF8.fromText $ ppTopElement $
unode "container" ! [("version","1.0")
,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
unode "rootfiles" $
unode "rootfile" ! [("full-path",
(if null epubSubdir
then ""
- else epubSubdir ++ "/") ++ "content.opf")
+ else T.pack epubSubdir <> "/") <> "content.opf")
,("media-type","application/oebps-package+xml")] $ ()
containerEntry <- mkEntry "META-INF/container.xml" containerData
-- com.apple.ibooks.display-options.xml
- let apple = UTF8.fromStringLazy $ ppTopElement $
+ let apple = B.fromStrict $ UTF8.fromText $ ppTopElement $
unode "display_options" $
unode "platform" ! [("name","*")] $
- unode "option" ! [("name","specified-fonts")] $ ("true" :: String)
+ unode "option" ! [("name","specified-fonts")] $ ("true" :: Text)
appleEntry <- mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple
-- construct archive
@@ -947,7 +950,8 @@ metadataElement version md currentTime =
++ publisherNodes ++ sourceNodes ++ relationNodes
++ coverageNodes ++ rightsNodes ++ coverImageNodes
++ modifiedNodes ++ belongsToCollectionNodes
- withIds base f = concat . zipWith f (map (\x -> base ++ ('-' : show x))
+ withIds base f = concat . zipWith f (map (\x -> base <>
+ T.cons '-' (tshow x))
([1..] :: [Int]))
identifierNodes = withIds "epub-id" toIdentifierNode $
epubIdentifier md
@@ -961,9 +965,9 @@ metadataElement version md currentTime =
(x:_) -> [dcNode "date" ! [("id","epub-date")]
$ dateText x]
ibooksNodes = map ibooksNode (epubIbooksFields md)
- ibooksNode (k, v) = unode "meta" ! [("property", "ibooks:" ++ k)] $ v
+ ibooksNode (k, v) = unode "meta" ! [("property", "ibooks:" <> k)] $ v
calibreNodes = map calibreNode (epubCalibreFields md)
- calibreNode (k, v) = unode "meta" ! [("name", "calibre:" ++ k),
+ calibreNode (k, v) = unode "meta" ! [("name", "calibre:" <> k),
("content", v)] $ ()
languageNodes = [dcTag "language" $ epubLanguage md]
creatorNodes = withIds "epub-creator" (toCreatorNode "creator") $
@@ -989,12 +993,12 @@ metadataElement version md currentTime =
maybe []
(\belongsToCollection -> (unode "meta" ! [("property", "belongs-to-collection"), ("id", "epub-id-1")] $ belongsToCollection )
:
- [unode "meta" ! [("refines", "#epub-id-1"), ("property", "collection-type")] $ ("series" :: String) ])
+ [unode "meta" ! [("refines", "#epub-id-1"), ("property", "collection-type")] $ ("series" :: Text) ])
(epubBelongsToCollection md)++
maybe []
(\groupPosition -> [unode "meta" ! [("refines", "#epub-id-1"), ("property", "group-position")] $ groupPosition ])
(epubGroupPosition md)
- dcTag n s = unode ("dc:" ++ n) s
+ dcTag n s = unode ("dc:" <> n) s
dcTag' n s = [dcTag n s]
toIdentifierNode id' (Identifier txt scheme)
| version == EPUB2 = [dcNode "identifier" !
@@ -1002,7 +1006,7 @@ metadataElement version md currentTime =
txt]
| otherwise = (dcNode "identifier" ! [("id",id')] $ txt) :
maybe [] ((\x -> [unode "meta" !
- [ ("refines",'#':id')
+ [ ("refines","#" <> id')
, ("property","identifier-type")
, ("scheme","onix:codelist5")
]
@@ -1018,10 +1022,10 @@ metadataElement version md currentTime =
(creatorRole creator >>= toRelator)) $ creatorText creator]
| otherwise = [dcNode s ! [("id",id')] $ creatorText creator] ++
maybe [] (\x -> [unode "meta" !
- [("refines",'#':id'),("property","file-as")] $ x])
+ [("refines","#" <> id'),("property","file-as")] $ x])
(creatorFileAs creator) ++
maybe [] (\x -> [unode "meta" !
- [("refines",'#':id'),("property","role"),
+ [("refines","#" <> id'),("property","role"),
("scheme","marc:relators")] $ x])
(creatorRole creator >>= toRelator)
toTitleNode id' title
@@ -1033,16 +1037,16 @@ metadataElement version md currentTime =
| otherwise = [dcNode "title" ! [("id",id')] $ titleText title]
++
maybe [] (\x -> [unode "meta" !
- [("refines",'#':id'),("property","file-as")] $ x])
+ [("refines","#" <> id'),("property","file-as")] $ x])
(titleFileAs title) ++
maybe [] (\x -> [unode "meta" !
- [("refines",'#':id'),("property","title-type")] $ x])
+ [("refines","#" <> id'),("property","title-type")] $ x])
(titleType title)
toDateNode id' date = [dcNode "date" !
(("id",id') :
maybe [] (\x -> [("opf:event",x)]) (dateEvent date)) $
dateText date]
- schemeToOnix :: String -> String
+ schemeToOnix :: Text -> Text
schemeToOnix "ISBN-10" = "02"
schemeToOnix "GTIN-13" = "03"
schemeToOnix "UPC" = "04"
@@ -1060,48 +1064,48 @@ metadataElement version md currentTime =
schemeToOnix "OLCC" = "28"
schemeToOnix _ = "01"
-showDateTimeISO8601 :: UTCTime -> String
-showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
+showDateTimeISO8601 :: UTCTime -> Text
+showDateTimeISO8601 = T.pack . formatTime defaultTimeLocale "%FT%TZ"
transformTag :: PandocMonad m
- => Tag TS.Text
- -> E m (Tag TS.Text)
+ => Tag T.Text
+ -> E m (Tag T.Text)
transformTag tag@(TagOpen name attr)
| name `elem` ["video", "source", "img", "audio"] &&
isNothing (lookup "data-external" attr) = do
let src = fromAttrib "src" tag
let poster = fromAttrib "poster" tag
- newsrc <- modifyMediaRef $ TS.unpack src
- newposter <- modifyMediaRef $ TS.unpack poster
+ newsrc <- modifyMediaRef $ T.unpack src
+ newposter <- modifyMediaRef $ T.unpack poster
let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
- [("src", "../" <> newsrc) | not (TS.null newsrc)] ++
- [("poster", "../" <> newposter) | not (TS.null newposter)]
+ [("src", "../" <> newsrc) | not (T.null newsrc)] ++
+ [("poster", "../" <> newposter) | not (T.null newposter)]
return $ TagOpen name attr'
transformTag tag = return tag
modifyMediaRef :: PandocMonad m
=> FilePath
- -> E m TS.Text
+ -> E m T.Text
modifyMediaRef "" = return ""
modifyMediaRef oldsrc = do
media <- gets stMediaPaths
case lookup oldsrc media of
- Just (n,_) -> return $ TS.pack n
+ Just (n,_) -> return $ T.pack n
Nothing -> catchError
- (do (img, mbMime) <- P.fetchItem $ TS.pack oldsrc
- let ext = maybe (takeExtension (takeWhile (/='?') oldsrc)) TS.unpack
+ (do (img, mbMime) <- P.fetchItem $ T.pack oldsrc
+ let ext = maybe (takeExtension (takeWhile (/='?') oldsrc)) T.unpack
(("." <>) <$> (mbMime >>= extensionFromMimeType))
newName <- getMediaNextNewName ext
let newPath = "media/" ++ newName
entry <- mkEntry newPath (B.fromChunks . (:[]) $ img)
modify $ \st -> st{ stMediaPaths =
(oldsrc, (newPath, Just entry)):media}
- return $ TS.pack newPath)
+ return $ T.pack newPath)
(\e -> do
- report $ CouldNotFetchResource (TS.pack oldsrc) (tshow e)
- return $ TS.pack oldsrc)
+ report $ CouldNotFetchResource (T.pack oldsrc) (tshow e)
+ return $ T.pack oldsrc)
-getMediaNextNewName :: PandocMonad m => String -> E m String
+getMediaNextNewName :: PandocMonad m => FilePath -> E m FilePath
getMediaNextNewName ext = do
nextId <- gets stMediaNextId
modify $ \st -> st { stMediaNextId = nextId + 1 }
@@ -1128,11 +1132,11 @@ transformInline :: PandocMonad m
-> Inline
-> E m Inline
transformInline _opts (Image attr lab (src,tit)) = do
- newsrc <- modifyMediaRef $ TS.unpack src
+ newsrc <- modifyMediaRef $ T.unpack src
return $ Image attr lab ("../" <> newsrc, tit)
transformInline opts x@(Math t m)
| WebTeX url <- writerHTMLMathMethod opts = do
- newsrc <- modifyMediaRef (TS.unpack url <> urlEncode (TS.unpack m))
+ newsrc <- modifyMediaRef (T.unpack url <> urlEncode (T.unpack m))
let mathclass = if t == DisplayMath then "display" else "inline"
return $ Span ("",["math",mathclass],[])
[Image nullAttr [x] ("../" <> newsrc, "")]
@@ -1143,40 +1147,26 @@ transformInline _opts (RawInline fmt raw)
return $ RawInline fmt (renderTags' tags')
transformInline _ x = return x
-(!) :: (t -> Element) -> [(String, String)] -> t -> Element
+(!) :: (t -> Element) -> [(Text, Text)] -> t -> Element
(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)
--- | Version of 'ppTopElement' that specifies UTF-8 encoding.
-ppTopElement :: Element -> String
-ppTopElement = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++) . unEntity . ppElement
- -- unEntity removes numeric entities introduced by ppElement
- -- (kindlegen seems to choke on these).
- where unEntity [] = ""
- unEntity ('&':'#':xs) =
- let (ds,ys) = break (==';') xs
- rest = drop 1 ys
- in case safeRead (TS.pack $ "'\\" <> ds <> "'") of
- Just x -> x : unEntity rest
- Nothing -> '&':'#':unEntity xs
- unEntity (x:xs) = x : unEntity xs
-
mediaTypeOf :: FilePath -> Maybe MimeType
mediaTypeOf x =
let mediaPrefixes = ["image", "video", "audio"] in
case getMimeType x of
- Just y | any (`TS.isPrefixOf` y) mediaPrefixes -> Just y
+ Just y | any (`T.isPrefixOf` y) mediaPrefixes -> Just y
_ -> Nothing
-- Returns filename for chapter number.
-showChapter :: Int -> String
-showChapter = printf "ch%03d.xhtml"
+showChapter :: Int -> Text
+showChapter = T.pack . printf "ch%03d.xhtml"
-- Add identifiers to any headers without them.
addIdentifiers :: WriterOptions -> [Block] -> [Block]
addIdentifiers opts bs = evalState (mapM go bs) Set.empty
where go (Header n (ident,classes,kvs) ils) = do
ids <- get
- let ident' = if TS.null ident
+ let ident' = if T.null ident
then uniqueIdent (writerExtensions opts) ils ids
else ident
modify $ Set.insert ident'
@@ -1184,27 +1174,27 @@ addIdentifiers opts bs = evalState (mapM go bs) Set.empty
go x = return x
-- Variant of normalizeDate that allows partial dates: YYYY, YYYY-MM
-normalizeDate' :: String -> Maybe String
-normalizeDate' = fmap TS.unpack . go . trim . TS.pack
+normalizeDate' :: Text -> Maybe Text
+normalizeDate' = go . T.strip
where
go xs
- | TS.length xs == 4 -- YYY
- , TS.all isDigit xs = Just xs
- | (y, s) <- TS.splitAt 4 xs -- YYY-MM
- , Just ('-', m) <- TS.uncons s
- , TS.length m == 2
- , TS.all isDigit y && TS.all isDigit m = Just xs
+ | T.length xs == 4 -- YYY
+ , T.all isDigit xs = Just xs
+ | (y, s) <- T.splitAt 4 xs -- YYY-MM
+ , Just ('-', m) <- T.uncons s
+ , T.length m == 2
+ , T.all isDigit y && T.all isDigit m = Just xs
| otherwise = normalizeDate xs
-toRelator :: String -> Maybe String
+toRelator :: Text -> Maybe Text
toRelator x
| x `elem` relators = Just x
- | otherwise = lookup (map toLower x) relatorMap
+ | otherwise = lookup (T.toLower x) relatorMap
-relators :: [String]
+relators :: [Text]
relators = map snd relatorMap
-relatorMap :: [(String, String)]
+relatorMap :: [(Text, Text)]
relatorMap =
[("abridger", "abr")
,("actor", "act")
diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs
index 9334d6e9a..3b5d04427 100644
--- a/src/Text/Pandoc/Writers/FB2.hs
+++ b/src/Text/Pandoc/Writers/FB2.hs
@@ -25,15 +25,12 @@ import Data.ByteString.Base64 (encode)
import Data.Char (isAscii, isControl, isSpace)
import Data.Either (lefts, rights)
import Data.List (intercalate)
-import Data.Text (Text, pack)
+import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as TE
import Network.HTTP (urlEncode)
-import Text.XML.Light
-import qualified Text.XML.Light as X
-import qualified Text.XML.Light.Cursor as XC
-import Text.Pandoc.XMLParser (parseXMLContents)
+import Text.Pandoc.XML.Light as X
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import qualified Text.Pandoc.Class.PandocMonad as P
@@ -44,6 +41,7 @@ import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def)
import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers,
makeSections, tshow, stringify)
import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable)
+import Data.Generics (everywhere, mkT)
-- | Data to be written at the end of the document:
-- (foot)notes, URLs, references, images.
@@ -88,7 +86,7 @@ pandocToFB2 opts (Pandoc meta blocks) = do
(imgs,missing) <- get >>= (lift . fetchImages . imagesToFetch)
let body' = replaceImagesWithAlt missing body
let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)
- return $ pack $ xml_head ++ showContent fb2_xml ++ "\n"
+ return $ xml_head <> showContent fb2_xml <> "\n"
where
xml_head = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
fb2_attrs =
@@ -100,8 +98,8 @@ pandocToFB2 opts (Pandoc meta blocks) = do
description :: PandocMonad m => Meta -> FBM m Content
description meta' = do
let genre = case lookupMetaString "genre" meta' of
- "" -> el "genre" ("unrecognised" :: String)
- s -> el "genre" (T.unpack s)
+ "" -> el "genre" ("unrecognised" :: Text)
+ s -> el "genre" s
bt <- booktitle meta'
let as = authors meta'
dd <- docdate meta'
@@ -112,7 +110,7 @@ description meta' = do
Just (MetaInlines [Str s]) -> [el "lang" $ iso639 s]
Just (MetaString s) -> [el "lang" $ iso639 s]
_ -> []
- where iso639 = T.unpack . T.takeWhile (/= '-') -- Convert BCP 47 to ISO 639
+ where iso639 = T.takeWhile (/= '-') -- Convert BCP 47 to ISO 639
let coverimage url = do
let img = Image nullAttr mempty (url, "")
im <- insertImage InlineImage img
@@ -124,7 +122,7 @@ description meta' = do
return $ el "description"
[ el "title-info" (genre :
(as ++ bt ++ annotation ++ dd ++ coverpage ++ lang))
- , el "document-info" [el "program-used" ("pandoc" :: String)]
+ , el "document-info" [el "program-used" ("pandoc" :: Text)]
]
booktitle :: PandocMonad m => Meta -> FBM m [Content]
@@ -137,15 +135,15 @@ authors meta' = cMap author (docAuthors meta')
author :: [Inline] -> [Content]
author ss =
- let ws = words . cMap plain $ ss
- email = el "email" <$> take 1 (filter ('@' `elem`) ws)
- ws' = filter ('@' `notElem`) ws
+ let ws = T.words $ mconcat $ map plain ss
+ email = el "email" <$> take 1 (filter (T.any (=='@')) ws)
+ ws' = filter (not . T.any (== '@')) ws
names = case ws' of
[nickname] -> [ el "nickname" nickname ]
[fname, lname] -> [ el "first-name" fname
, el "last-name" lname ]
(fname:rest) -> [ el "first-name" fname
- , el "middle-name" (concat . init $ rest)
+ , el "middle-name" (T.concat . init $ rest)
, el "last-name" (last rest) ]
[] -> []
in list $ el "author" (names ++ email)
@@ -206,7 +204,7 @@ renderFootnotes = do
el "body" ([uattr "name" "notes"], map renderFN (reverse fns))
where
renderFN (n, idstr, cs) =
- let fn_texts = el "title" (el "p" (show n)) : cs
+ let fn_texts = el "title" (el "p" (tshow n)) : cs
in el "section" ([uattr "id" idstr], fn_texts)
-- | Fetch images and encode them for the FictionBook XML.
@@ -282,7 +280,7 @@ isMimeType s =
where
types = ["text","image","audio","video","application","message","multipart"]
valid c = isAscii c && not (isControl c) && not (isSpace c) &&
- c `notElem` ("()<>@,;:\\\"/[]?=" :: String)
+ c `notElem` ("()<>@,;:\\\"/[]?=" :: [Char])
footnoteID :: Int -> Text
footnoteID i = "n" <> tshow i
@@ -306,7 +304,7 @@ blockToXml (Para [Image atr alt (src,tgt)])
= insertImage NormalImage (Image atr alt (src,tit))
blockToXml (Para ss) = list . el "p" <$> cMapM toXml ss
blockToXml (CodeBlock _ s) = return . spaceBeforeAfter .
- map (el "p" . el "code" . T.unpack) . T.lines $ s
+ map (el "p" . el "code") . T.lines $ s
blockToXml (RawBlock f str) =
if f == Format "fb2"
then
@@ -346,11 +344,11 @@ blockToXml (Table _ blkCapt specs thead tbody tfoot) = do
c <- el "emphasis" <$> cMapM toXml caption
return [el "table" (hd <> bd), el "p" c]
where
- mkrow :: PandocMonad m => String -> [[Block]] -> [Alignment] -> FBM m Content
+ mkrow :: PandocMonad m => Text -> [[Block]] -> [Alignment] -> FBM m Content
mkrow tag cells aligns' =
el "tr" <$> mapM (mkcell tag) (zip cells aligns')
--
- mkcell :: PandocMonad m => String -> ([Block], Alignment) -> FBM m Content
+ mkcell :: PandocMonad m => Text -> ([Block], Alignment) -> FBM m Content
mkcell tag (cell, align) = do
cblocks <- cMapM blockToXml cell
return $ el tag ([align_attr align], cblocks)
@@ -424,7 +422,7 @@ toXml (Quoted DoubleQuote ss) = do
inner <- cMapM toXml ss
return $ [txt "“"] ++ inner ++ [txt "”"]
toXml (Cite _ ss) = cMapM toXml ss -- FIXME: support citation styles
-toXml (Code _ s) = return [el "code" $ T.unpack s]
+toXml (Code _ s) = return [el "code" s]
toXml Space = return [txt " "]
toXml SoftBreak = return [txt "\n"]
toXml LineBreak = return [txt "\n"]
@@ -456,7 +454,7 @@ insertMath immode formula = do
let imgurl = url <> T.pack (urlEncode $ T.unpack formula)
let img = Image nullAttr alt (imgurl, "")
insertImage immode img
- _ -> return [el "code" $ T.unpack formula]
+ _ -> return [el "code" formula]
insertImage :: PandocMonad m => ImageMode -> Inline -> FBM m [Content]
insertImage immode (Image _ alt (url,ttl)) = do
@@ -471,31 +469,16 @@ insertImage immode (Image _ alt (url,ttl)) = do
el "image" $
[ attr ("l","href") ("#" <> fname)
, attr ("l","type") (tshow immode)
- , uattr "alt" (T.pack $ cMap plain alt) ]
+ , uattr "alt" (mconcat $ map plain alt) ]
++ ttlattr
insertImage _ _ = error "unexpected inline instead of image"
replaceImagesWithAlt :: [Text] -> Content -> Content
-replaceImagesWithAlt missingHrefs body =
- let cur = XC.fromContent body
- cur' = replaceAll cur
- in XC.toTree . XC.root $ cur'
+replaceImagesWithAlt missingHrefs = everywhere (mkT go)
where
- --
- replaceAll :: XC.Cursor -> XC.Cursor
- replaceAll c =
- let n = XC.current c
- c' = if isImage n && isMissing n
- then XC.modifyContent replaceNode c
- else c
- in case XC.nextDF c' of
- (Just cnext) -> replaceAll cnext
- Nothing -> c' -- end of document
- --
- isImage :: Content -> Bool
- isImage (Elem e) = elName e == uname "image"
- isImage _ = False
- --
+ go c = if isMissing c
+ then replaceNode c
+ else c
isMissing (Elem img@Element{}) =
let imgAttrs = elAttribs img
badAttrs = map (attr ("l","href")) missingHrefs
@@ -505,18 +488,18 @@ replaceImagesWithAlt missingHrefs body =
replaceNode :: Content -> Content
replaceNode n@(Elem img@Element{}) =
let attrs = elAttribs img
- alt = getAttrVal attrs (uname "alt")
+ alt = getAttrVal attrs (unqual "alt")
imtype = getAttrVal attrs (qname "l" "type")
in case (alt, imtype) of
(Just alt', Just imtype') ->
- if imtype' == show NormalImage
+ if imtype' == tshow NormalImage
then el "p" alt'
- else txt $ T.pack alt'
- (Just alt', Nothing) -> txt $ T.pack alt' -- no type attribute
+ else txt alt'
+ (Just alt', Nothing) -> txt alt' -- no type attribute
_ -> n -- don't replace if alt text is not found
replaceNode n = n
--
- getAttrVal :: [X.Attr] -> QName -> Maybe String
+ getAttrVal :: [X.Attr] -> QName -> Maybe Text
getAttrVal attrs name =
case filter ((name ==) . attrKey) attrs of
(a:_) -> Just (attrVal a)
@@ -524,7 +507,7 @@ replaceImagesWithAlt missingHrefs body =
-- | Wrap all inlines with an XML tag (given its unqualified name).
-wrap :: PandocMonad m => String -> [Inline] -> FBM m Content
+wrap :: PandocMonad m => Text -> [Inline] -> FBM m Content
wrap tagname inlines = el tagname `liftM` cMapM toXml inlines
-- " Create a singleton list.
@@ -532,31 +515,31 @@ list :: a -> [a]
list = (:[])
-- | Convert an 'Inline' to plaintext.
-plain :: Inline -> String
-plain (Str s) = T.unpack s
-plain (Emph ss) = cMap plain ss
-plain (Underline ss) = cMap plain ss
-plain (Span _ ss) = cMap plain ss
-plain (Strong ss) = cMap plain ss
-plain (Strikeout ss) = cMap plain ss
-plain (Superscript ss) = cMap plain ss
-plain (Subscript ss) = cMap plain ss
-plain (SmallCaps ss) = cMap plain ss
-plain (Quoted _ ss) = cMap plain ss
-plain (Cite _ ss) = cMap plain ss -- FIXME
-plain (Code _ s) = T.unpack s
+plain :: Inline -> Text
+plain (Str s) = s
+plain (Emph ss) = mconcat $ map plain ss
+plain (Underline ss) = mconcat $ map plain ss
+plain (Span _ ss) = mconcat $ map plain ss
+plain (Strong ss) = mconcat $ map plain ss
+plain (Strikeout ss) = mconcat $ map plain ss
+plain (Superscript ss) = mconcat $ map plain ss
+plain (Subscript ss) = mconcat $ map plain ss
+plain (SmallCaps ss) = mconcat $ map plain ss
+plain (Quoted _ ss) = mconcat $ map plain ss
+plain (Cite _ ss) = mconcat $ map plain ss -- FIXME
+plain (Code _ s) = s
plain Space = " "
plain SoftBreak = " "
plain LineBreak = "\n"
-plain (Math _ s) = T.unpack s
+plain (Math _ s) = s
plain (RawInline _ _) = ""
-plain (Link _ text (url,_)) = concat (map plain text ++ [" <", T.unpack url, ">"])
-plain (Image _ alt _) = cMap plain alt
+plain (Link _ text (url,_)) = mconcat (map plain text ++ [" <", url, ">"])
+plain (Image _ alt _) = mconcat $ map plain alt
plain (Note _) = "" -- FIXME
-- | Create an XML element.
el :: (Node t)
- => String -- ^ unqualified element name
+ => Text -- ^ unqualified element name
-> t -- ^ node contents
-> Content -- ^ XML content
el name cs = Elem $ unode name cs
@@ -569,22 +552,18 @@ spaceBeforeAfter cs =
-- | Create a plain-text XML content.
txt :: Text -> Content
-txt s = Text $ CData CDataText (T.unpack s) Nothing
+txt s = Text $ CData CDataText s Nothing
-- | Create an XML attribute with an unqualified name.
-uattr :: String -> Text -> Text.XML.Light.Attr
-uattr name = Attr (uname name) . T.unpack
+uattr :: Text -> Text -> X.Attr
+uattr name = Attr (unqual name)
-- | Create an XML attribute with a qualified name from given namespace.
-attr :: (String, String) -> Text -> Text.XML.Light.Attr
-attr (ns, name) = Attr (qname ns name) . T.unpack
-
--- | Unqualified name
-uname :: String -> QName
-uname name = QName name Nothing Nothing
+attr :: (Text, Text) -> Text -> X.Attr
+attr (ns, name) = Attr (qname ns name)
-- | Qualified name
-qname :: String -> String -> QName
+qname :: Text -> Text -> QName
qname ns name = QName name Nothing (Just ns)
-- | Abbreviation for 'concatMap'.
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index 06369b4db..101b236aa 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -40,9 +40,9 @@ import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toTextLazy)
import Text.Pandoc.Walk
import Text.Pandoc.Writers.OpenDocument (writeOpenDocument)
import Text.Pandoc.XML
-import Text.Pandoc.XMLParser (parseXMLElement)
+import Text.Pandoc.XML.Light
import Text.TeXMath
-import Text.XML.Light
+import qualified Text.XML.Light as XL
newtype ODTState = ODTState { stEntries :: [Entry]
}
@@ -181,18 +181,20 @@ updateStyleWithLang (Just lang) arch = do
PandocXMLError "styles.xml" msg
Right d -> return $
toEntry "styles.xml" epochtime
- ( fromStringLazy
+ ( fromTextLazy
+ . TL.fromStrict
. ppTopElement
. addLang lang $ d )
else return e) (zEntries arch)
return arch{ zEntries = entries }
+-- TODO FIXME avoid this generic traversal!
addLang :: Lang -> Element -> Element
addLang lang = everywhere' (mkT updateLangAttr)
where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) _)
- = Attr n (T.unpack $ langLanguage lang)
+ = Attr n (langLanguage lang)
updateLangAttr (Attr n@(QName "country" _ (Just "fo")) _)
- = Attr n (T.unpack $ langRegion lang)
+ = Attr n (langRegion lang)
updateLangAttr x = x
-- | transform both Image and Math elements
@@ -238,8 +240,8 @@ transformPicMath _ (Math t math) = do
case writeMathML dt <$> readTeX math of
Left _ -> return $ Math t math
Right r -> do
- let conf = useShortEmptyTags (const False) defaultConfigPP
- let mathml = ppcTopElement conf r
+ let conf = XL.useShortEmptyTags (const False) XL.defaultConfigPP
+ let mathml = XL.ppcTopElement conf r
epochtime <- floor `fmap` lift P.getPOSIXTime
let dirname = "Formula-" ++ show (length entries) ++ "/"
let fname = dirname ++ "content.xml"
diff --git a/src/Text/Pandoc/Writers/OOXML.hs b/src/Text/Pandoc/Writers/OOXML.hs
index 8f60e70d5..0533d6c12 100644
--- a/src/Text/Pandoc/Writers/OOXML.hs
+++ b/src/Text/Pandoc/Writers/OOXML.hs
@@ -29,33 +29,32 @@ import Control.Monad.Except (throwError)
import Text.Pandoc.Error
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
+import Data.Text (Text)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import qualified Text.Pandoc.UTF8 as UTF8
-import Text.XML.Light as XML
-import Text.Pandoc.XMLParser (parseXMLElement)
+import Text.Pandoc.XML.Light
-mknode :: Node t => String -> [(String,String)] -> t -> Element
+mknode :: Node t => Text -> [(Text,Text)] -> t -> Element
mknode s attrs =
add_attrs (map (\(k,v) -> Attr (nodename k) v) attrs) . node (nodename s)
-mktnode :: String -> [(String,String)] -> T.Text -> Element
-mktnode s attrs = mknode s attrs . T.unpack
+mktnode :: Text -> [(Text,Text)] -> T.Text -> Element
+mktnode s attrs = mknode s attrs
-nodename :: String -> QName
+nodename :: Text -> QName
nodename s = QName{ qName = name, qURI = Nothing, qPrefix = prefix }
- where (name, prefix) = case break (==':') s of
- (xs,[]) -> (xs, Nothing)
- (ys, _:zs) -> (zs, Just ys)
+ where (name, prefix) = case T.break (==':') s of
+ (xs,ys) -> case T.uncons ys of
+ Nothing -> (xs, Nothing)
+ Just (_,zs) -> (zs, Just xs)
toLazy :: B.ByteString -> BL.ByteString
toLazy = BL.fromChunks . (:[])
renderXml :: Element -> BL.ByteString
-renderXml elt = BL8.pack "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" <>
- UTF8.fromStringLazy (showElement elt)
+renderXml elt = BL.fromStrict (UTF8.fromText (showTopElement elt))
parseXml :: PandocMonad m => Archive -> Archive -> String -> m Element
parseXml refArchive distArchive relpath =
@@ -70,25 +69,25 @@ parseXml refArchive distArchive relpath =
-- Copied from Util
-attrToNSPair :: XML.Attr -> Maybe (String, String)
-attrToNSPair (XML.Attr (QName s _ (Just "xmlns")) val) = Just (s, val)
+attrToNSPair :: Attr -> Maybe (Text, Text)
+attrToNSPair (Attr (QName s _ (Just "xmlns")) val) = Just (s, val)
attrToNSPair _ = Nothing
elemToNameSpaces :: Element -> NameSpaces
elemToNameSpaces = mapMaybe attrToNSPair . elAttribs
-elemName :: NameSpaces -> String -> String -> QName
+elemName :: NameSpaces -> Text -> Text -> QName
elemName ns prefix name =
- QName name (lookup prefix ns) (if null prefix then Nothing else Just prefix)
+ QName name (lookup prefix ns) (if T.null prefix then Nothing else Just prefix)
-isElem :: NameSpaces -> String -> String -> Element -> Bool
+isElem :: NameSpaces -> Text -> Text -> Element -> Bool
isElem ns prefix name element =
let ns' = ns ++ elemToNameSpaces element
in qName (elName element) == name &&
qURI (elName element) == lookup prefix ns'
-type NameSpaces = [(String, String)]
+type NameSpaces = [(Text, Text)]
-- | Scales the image to fit the page
-- sizes are passed in emu
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index 0a7060895..5caeb0753 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -20,16 +20,16 @@ import Control.Monad.Except (throwError, catchError)
import Control.Monad.Reader
import Control.Monad.State
import Codec.Archive.Zip
-import Data.Char (toUpper)
import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf, intersperse)
import Data.Default
+import Data.Text (Text)
import qualified Data.Text as T
+import qualified Data.Text.Read
import Data.Time (formatTime, defaultTimeLocale)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension)
-import Text.XML.Light
-import Text.Pandoc.XMLParser (parseXMLElement)
+import Text.Pandoc.XML.Light as XML
import Text.Pandoc.Definition
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Class.PandocMonad (PandocMonad)
@@ -48,6 +48,7 @@ import Text.DocTemplates (FromContext(lookupContext))
import Text.TeXMath
import Text.Pandoc.Writers.Math (convertMath)
import Text.Pandoc.Writers.Powerpoint.Presentation
+import Text.Pandoc.Shared (tshow)
import Skylighting (fromColor)
-- |The 'EMU' type is used to specify sizes in English Metric Units.
@@ -84,10 +85,13 @@ getPresentationSize refArchive distArchive = do
sldSize <- findChild (elemName ns "p" "sldSz") presElement
cxS <- findAttr (QName "cx" Nothing Nothing) sldSize
cyS <- findAttr (QName "cy" Nothing Nothing) sldSize
- (cx, _) <- listToMaybe $ reads cxS :: Maybe (Integer, String)
- (cy, _) <- listToMaybe $ reads cyS :: Maybe (Integer, String)
+ cx <- readTextAsInteger cxS
+ cy <- readTextAsInteger cyS
return (cx `div` 12700, cy `div` 12700)
+readTextAsInteger :: Text -> Maybe Integer
+readTextAsInteger = either (const Nothing) (Just . fst) . Data.Text.Read.decimal
+
data WriterEnv = WriterEnv { envRefArchive :: Archive
, envDistArchive :: Archive
, envUTCTime :: UTCTime
@@ -161,9 +165,6 @@ runP env st p = evalStateT (runReaderT p env) st
--------------------------------------------------------------------
-findAttrText :: QName -> Element -> Maybe T.Text
-findAttrText n = fmap T.pack . findAttr n
-
monospaceFont :: Monad m => P m T.Text
monospaceFont = do
vars <- writerVariables <$> asks envOpts
@@ -171,10 +172,9 @@ monospaceFont = do
Just s -> return s
Nothing -> return "Courier"
--- Kept as string for XML.Light
-fontSizeAttributes :: Monad m => RunProps -> P m [(String, String)]
+fontSizeAttributes :: Monad m => RunProps -> P m [(Text, Text)]
fontSizeAttributes RunProps { rPropForceSize = Just sz } =
- return [("sz", show $ sz * 100)]
+ return [("sz", tshow $ sz * 100)]
fontSizeAttributes _ = return []
copyFileToArchive :: PandocMonad m => Archive -> FilePath -> P m Archive
@@ -365,7 +365,7 @@ shapeHasId :: NameSpaces -> T.Text -> Element -> Bool
shapeHasId ns ident element
| Just nvSpPr <- findChild (elemName ns "p" "nvSpPr") element
, Just cNvPr <- findChild (elemName ns "p" "cNvPr") nvSpPr
- , Just nm <- findAttrText (QName "id" Nothing Nothing) cNvPr =
+ , Just nm <- findAttr (QName "id" Nothing Nothing) cNvPr =
nm == ident
| otherwise = False
@@ -396,10 +396,10 @@ getShapeDimensions ns element
ext <- findChild (elemName ns "a" "ext") xfrm
cxS <- findAttr (QName "cx" Nothing Nothing) ext
cyS <- findAttr (QName "cy" Nothing Nothing) ext
- (x, _) <- listToMaybe $ reads xS
- (y, _) <- listToMaybe $ reads yS
- (cx, _) <- listToMaybe $ reads cxS
- (cy, _) <- listToMaybe $ reads cyS
+ x <- readTextAsInteger xS
+ y <- readTextAsInteger yS
+ cx <- readTextAsInteger cxS
+ cy <- readTextAsInteger cyS
return ((x `div` 12700, y `div` 12700),
(cx `div` 12700, cy `div` 12700))
| otherwise = Nothing
@@ -430,7 +430,7 @@ getContentShapeSize ns layout master
Nothing -> do let mbSz =
findChild (elemName ns "p" "nvSpPr") sp >>=
findChild (elemName ns "p" "cNvPr") >>=
- findAttrText (QName "id" Nothing Nothing) >>=
+ findAttr (QName "id" Nothing Nothing) >>=
flip getMasterShapeDimensionsById master
case mbSz of
Just sz' -> return sz'
@@ -450,8 +450,8 @@ buildSpTree ns spTreeElem newShapes =
fn _ = True
replaceNamedChildren :: NameSpaces
- -> String
- -> String
+ -> Text
+ -> Text
-> [Element]
-> Element
-> Element
@@ -654,10 +654,10 @@ createCaption contentShapeDimensions paraElements = do
]
, mknode "p:spPr" []
[ mknode "a:xfrm" []
- [ mknode "a:off" [("x", show $ 12700 * x),
- ("y", show $ 12700 * (y + cy - captionHeight))] ()
- , mknode "a:ext" [("cx", show $ 12700 * cx),
- ("cy", show $ 12700 * captionHeight)] ()
+ [ mknode "a:off" [("x", tshow $ 12700 * x),
+ ("y", tshow $ 12700 * (y + cy - captionHeight))] ()
+ , mknode "a:ext" [("cx", tshow $ 12700 * cx),
+ ("cy", tshow $ 12700 * captionHeight)] ()
]
, mknode "a:prstGeom" [("prst", "rect")]
[ mknode "a:avLst" [] ()
@@ -706,11 +706,13 @@ makePicElements layout picProps mInfo alt = do
,("noChangeAspect","1")] ()
-- cNvPr will contain the link information so we do that separately,
-- and register the link if necessary.
- let cNvPrAttr = [("descr", mInfoFilePath mInfo), ("id","0"),("name","Picture 1")]
+ let cNvPrAttr = [("descr", T.pack $ mInfoFilePath mInfo),
+ ("id","0"),
+ ("name","Picture 1")]
cNvPr <- case picPropLink picProps of
Just link -> do idNum <- registerLink link
return $ mknode "p:cNvPr" cNvPrAttr $
- mknode "a:hlinkClick" [("r:id", "rId" <> show idNum)] ()
+ mknode "a:hlinkClick" [("r:id", "rId" <> tshow idNum)] ()
Nothing -> return $ mknode "p:cNvPr" cNvPrAttr ()
let nvPicPr = mknode "p:nvPicPr" []
[ cNvPr
@@ -718,13 +720,13 @@ makePicElements layout picProps mInfo alt = do
, mknode "p:nvPr" [] ()]
let blipFill = mknode "p:blipFill" []
[ mknode "a:blip" [("r:embed", "rId" <>
- show (mInfoLocalId mInfo))] ()
+ tshow (mInfoLocalId mInfo))] ()
, mknode "a:stretch" [] $
mknode "a:fillRect" [] () ]
let xfrm = mknode "a:xfrm" []
- [ mknode "a:off" [("x",show xoff'), ("y",show yoff')] ()
- , mknode "a:ext" [("cx",show dimX')
- ,("cy",show dimY')] () ]
+ [ mknode "a:off" [("x", tshow xoff'), ("y", tshow yoff')] ()
+ , mknode "a:ext" [("cx", tshow dimX')
+ ,("cy", tshow dimY')] () ]
let prstGeom = mknode "a:prstGeom" [("prst","rect")] $
mknode "a:avLst" [] ()
let ln = mknode "a:ln" [("w","9525")]
@@ -763,7 +765,7 @@ paraElemToElements (Run rpr s) = do
Just DoubleStrike -> [("strike", "dblStrike")]
Nothing -> []) <>
(case rBaseline rpr of
- Just n -> [("baseline", show n)]
+ Just n -> [("baseline", tshow n)]
Nothing -> []) <>
(case rCap rpr of
Just NoCapitals -> [("cap", "none")]
@@ -780,43 +782,44 @@ paraElemToElements (Run rpr s) = do
return $ case link of
InternalTarget _ ->
let linkAttrs =
- [ ("r:id", "rId" <> show idNum)
+ [ ("r:id", "rId" <> tshow idNum)
, ("action", "ppaction://hlinksldjump")
]
in [mknode "a:hlinkClick" linkAttrs ()]
-- external
ExternalTarget _ ->
let linkAttrs =
- [ ("r:id", "rId" <> show idNum)
+ [ ("r:id", "rId" <> tshow idNum)
]
in [mknode "a:hlinkClick" linkAttrs ()]
Nothing -> return []
let colorContents = case rSolidFill rpr of
Just color ->
case fromColor color of
- '#':hx -> [mknode "a:solidFill" []
- [mknode "a:srgbClr" [("val", map toUpper hx)] ()]
- ]
+ '#':hx ->
+ [mknode "a:solidFill" []
+ [mknode "a:srgbClr"
+ [("val", T.toUpper $ T.pack hx)] ()]]
_ -> []
Nothing -> []
codeFont <- monospaceFont
let codeContents =
- [mknode "a:latin" [("typeface", T.unpack codeFont)] () | rPropCode rpr]
+ [mknode "a:latin" [("typeface", codeFont)] () | rPropCode rpr]
let propContents = linkProps <> colorContents <> codeContents
return [Elem $ mknode "a:r" [] [ mknode "a:rPr" attrs propContents
- , mknode "a:t" [] $ T.unpack s
+ , mknode "a:t" [] s
]]
paraElemToElements (MathElem mathType texStr) = do
isInSpkrNotes <- asks envInSpeakerNotes
if isInSpkrNotes
then paraElemToElements $ Run def $ unTeXString texStr
else do res <- convertMath writeOMML mathType (unTeXString texStr)
- case res of
+ case fromXLElement <$> res of
Right r -> return [Elem $ mknode "a14:m" [] $ addMathInfo r]
Left (Str s) -> paraElemToElements (Run def s)
Left _ -> throwError $ PandocShouldNeverHappenError "non-string math fallback"
paraElemToElements (RawOOXMLParaElem str) = return
- [Text (CData CDataRaw (T.unpack str) Nothing)]
+ [Text (CData CDataRaw str Nothing)]
-- This is a bit of a kludge -- really requires adding an option to
@@ -824,9 +827,10 @@ paraElemToElements (RawOOXMLParaElem str) = return
-- step at a time.
addMathInfo :: Element -> Element
addMathInfo element =
- let mathspace = Attr { attrKey = QName "m" Nothing (Just "xmlns")
- , attrVal = "http://schemas.openxmlformats.org/officeDocument/2006/math"
- }
+ let mathspace =
+ Attr { attrKey = QName "m" Nothing (Just "xmlns")
+ , attrVal = "http://schemas.openxmlformats.org/officeDocument/2006/math"
+ }
in add_attr mathspace element
-- We look through the element to see if it contains an a14:m
@@ -849,13 +853,13 @@ surroundWithMathAlternate element =
paragraphToElement :: PandocMonad m => Paragraph -> P m Element
paragraphToElement par = do
let
- attrs = [("lvl", show $ pPropLevel $ paraProps par)] <>
+ attrs = [("lvl", tshow $ pPropLevel $ paraProps par)] <>
(case pPropMarginLeft (paraProps par) of
- Just px -> [("marL", show $ pixelsToEmu px)]
+ Just px -> [("marL", tshow $ pixelsToEmu px)]
Nothing -> []
) <>
(case pPropIndent (paraProps par) of
- Just px -> [("indent", show $ pixelsToEmu px)]
+ Just px -> [("indent", tshow $ pixelsToEmu px)]
Nothing -> []
) <>
(case pPropAlign (paraProps par) of
@@ -867,7 +871,7 @@ paragraphToElement par = do
props = [] <>
(case pPropSpaceBefore $ paraProps par of
Just px -> [mknode "a:spcBef" [] [
- mknode "a:spcPts" [("val", show $ 100 * px)] ()
+ mknode "a:spcPts" [("val", tshow $ 100 * px)] ()
]
]
Nothing -> []
@@ -910,7 +914,7 @@ shapeToElements layout (Pic picProps fp alt) = do
shapeToElements layout (GraphicFrame tbls cptn) = map Elem <$>
graphicFrameToElements layout tbls cptn
shapeToElements _ (RawOOXMLShape str) = return
- [Text (CData CDataRaw (T.unpack str) Nothing)]
+ [Text (CData CDataRaw str Nothing)]
shapeToElements layout shp = do
element <- shapeToElement layout shp
return [Elem element]
@@ -942,8 +946,10 @@ graphicFrameToElements layout tbls caption = do
[mknode "p:ph" [("idx", "1")] ()]
]
, mknode "p:xfrm" []
- [ mknode "a:off" [("x", show $ 12700 * x), ("y", show $ 12700 * y)] ()
- , mknode "a:ext" [("cx", show $ 12700 * cx), ("cy", show $ 12700 * cy)] ()
+ [ mknode "a:off" [("x", tshow $ 12700 * x),
+ ("y", tshow $ 12700 * y)] ()
+ , mknode "a:ext" [("cx", tshow $ 12700 * cx),
+ ("cy", tshow $ 12700 * cy)] ()
]
] <> elements
@@ -957,7 +963,7 @@ getDefaultTableStyle = do
refArchive <- asks envRefArchive
distArchive <- asks envDistArchive
tblStyleLst <- parseXml refArchive distArchive "ppt/tableStyles.xml"
- return $ findAttrText (QName "def" Nothing Nothing) tblStyleLst
+ return $ findAttr (QName "def" Nothing Nothing) tblStyleLst
graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element
graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do
@@ -995,7 +1001,7 @@ graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do
let mkrow border cells = mknode "a:tr" [("h", "0")] $ map (mkcell border) cells
let mkgridcol w = mknode "a:gridCol"
- [("w", show ((12700 * w) :: Integer))] ()
+ [("w", tshow ((12700 * w) :: Integer))] ()
let hasHeader = not (all null hdrCells)
mbDefTblStyle <- getDefaultTableStyle
@@ -1004,7 +1010,7 @@ graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do
, ("bandRow", if tblPrBandRow tblPr then "1" else "0")
] (case mbDefTblStyle of
Nothing -> []
- Just sty -> [mknode "a:tableStyleId" [] $ T.unpack sty])
+ Just sty -> [mknode "a:tableStyleId" [] sty])
return $ mknode "a:graphic" []
[mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")]
@@ -1037,7 +1043,7 @@ findPHType ns spElem phType
-- if it's a named PHType, we want to check that the attribute
-- value matches.
Just phElem | (PHType tp) <- phType ->
- case findAttrText (QName "type" Nothing Nothing) phElem of
+ case findAttr (QName "type" Nothing Nothing) phElem of
Just tp' -> tp == tp'
Nothing -> False
-- if it's an ObjType, we want to check that there is NO
@@ -1204,7 +1210,7 @@ getSlideNumberFieldId notesMaster
, Just txBody <- findChild (elemName ns "p" "txBody") sp
, Just p <- findChild (elemName ns "a" "p") txBody
, Just fld <- findChild (elemName ns "a" "fld") p
- , Just fldId <- findAttrText (QName "id" Nothing Nothing) fld =
+ , Just fldId <- findAttr (QName "id" Nothing Nothing) fld =
return fldId
| otherwise = throwError $
PandocSomeError
@@ -1283,11 +1289,11 @@ speakerNotesSlideNumber pgNum fieldId =
[ mknode "a:bodyPr" [] ()
, mknode "a:lstStyle" [] ()
, mknode "a:p" []
- [ mknode "a:fld" [ ("id", T.unpack fieldId)
+ [ mknode "a:fld" [ ("id", fieldId)
, ("type", "slidenum")
]
[ mknode "a:rPr" [("lang", "en-US")] ()
- , mknode "a:t" [] (show pgNum)
+ , mknode "a:t" [] (tshow pgNum)
]
, mknode "a:endParaRPr" [("lang", "en-US")] ()
]
@@ -1339,7 +1345,7 @@ getSlideIdNum sldId = do
Just n -> return n
Nothing -> throwError $
PandocShouldNeverHappenError $
- "Slide Id " <> T.pack (show sldId) <> " not found."
+ "Slide Id " <> tshow sldId <> " not found."
slideNum :: PandocMonad m => Slide -> P m Int
slideNum slide = getSlideIdNum $ slideId slide
@@ -1356,7 +1362,7 @@ slideToRelId :: PandocMonad m => Slide -> P m T.Text
slideToRelId slide = do
n <- slideNum slide
offset <- asks envSlideIdOffset
- return $ "rId" <> T.pack (show $ n + offset)
+ return $ "rId" <> tshow (n + offset)
data Relationship = Relationship { relId :: Int
@@ -1368,13 +1374,11 @@ elementToRel :: Element -> Maybe Relationship
elementToRel element
| elName element == QName "Relationship" (Just "http://schemas.openxmlformats.org/package/2006/relationships") Nothing =
do rId <- findAttr (QName "Id" Nothing Nothing) element
- numStr <- stripPrefix "rId" rId
- num <- case reads numStr :: [(Int, String)] of
- (n, _) : _ -> Just n
- [] -> Nothing
- type' <- findAttrText (QName "Type" Nothing Nothing) element
+ numStr <- T.stripPrefix "rId" rId
+ num <- fromIntegral <$> readTextAsInteger numStr
+ type' <- findAttr (QName "Type" Nothing Nothing) element
target <- findAttr (QName "Target" Nothing Nothing) element
- return $ Relationship num type' target
+ return $ Relationship num type' (T.unpack target)
| otherwise = Nothing
slideToPresRel :: PandocMonad m => Slide -> P m Relationship
@@ -1463,10 +1467,9 @@ topLevelRelsEntry :: PandocMonad m => P m Entry
topLevelRelsEntry = elemToEntry "_rels/.rels" $ relsToElement topLevelRels
relToElement :: Relationship -> Element
-relToElement rel = mknode "Relationship" [ ("Id", "rId" <>
- show (relId rel))
- , ("Type", T.unpack $ relType rel)
- , ("Target", relTarget rel) ] ()
+relToElement rel = mknode "Relationship" [ ("Id", "rId" <> tshow (relId rel))
+ , ("Type", relType rel)
+ , ("Target", T.pack $ relTarget rel) ] ()
relsToElement :: [Relationship] -> Element
relsToElement rels = mknode "Relationships"
@@ -1501,7 +1504,8 @@ slideToSpeakerNotesEntry slide = do
Just element | Just notesIdNum <- mbNotesIdNum ->
Just <$>
elemToEntry
- ("ppt/notesSlides/notesSlide" <> show notesIdNum <> ".xml")
+ ("ppt/notesSlides/notesSlide" <> show notesIdNum <>
+ ".xml")
element
_ -> return Nothing
@@ -1514,7 +1518,7 @@ slideToSpeakerNotesRelElement slide@Slide{} = do
[("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
[ mknode "Relationship" [ ("Id", "rId2")
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
- , ("Target", "../slides/slide" <> show idNum <> ".xml")
+ , ("Target", "../slides/slide" <> tshow idNum <> ".xml")
] ()
, mknode "Relationship" [ ("Id", "rId1")
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
@@ -1547,15 +1551,15 @@ linkRelElement :: PandocMonad m => (Int, LinkTarget) -> P m Element
linkRelElement (rIdNum, InternalTarget targetId) = do
targetIdNum <- getSlideIdNum targetId
return $
- mknode "Relationship" [ ("Id", "rId" <> show rIdNum)
+ mknode "Relationship" [ ("Id", "rId" <> tshow rIdNum)
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
- , ("Target", "slide" <> show targetIdNum <> ".xml")
+ , ("Target", "slide" <> tshow targetIdNum <> ".xml")
] ()
linkRelElement (rIdNum, ExternalTarget (url, _)) =
return $
- mknode "Relationship" [ ("Id", "rId" <> show rIdNum)
+ mknode "Relationship" [ ("Id", "rId" <> tshow rIdNum)
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")
- , ("Target", T.unpack url)
+ , ("Target", url)
, ("TargetMode", "External")
] ()
@@ -1567,10 +1571,10 @@ mediaRelElement mInfo =
let ext = fromMaybe "" (mInfoExt mInfo)
in
mknode "Relationship" [ ("Id", "rId" <>
- show (mInfoLocalId mInfo))
+ tshow (mInfoLocalId mInfo))
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image")
, ("Target", "../media/image" <>
- show (mInfoGlobalId mInfo) <> T.unpack ext)
+ tshow (mInfoGlobalId mInfo) <> ext)
] ()
speakerNotesSlideRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
@@ -1580,7 +1584,7 @@ speakerNotesSlideRelElement slide = do
return $ case M.lookup idNum mp of
Nothing -> Nothing
Just n ->
- let target = "../notesSlides/notesSlide" <> show n <> ".xml"
+ let target = "../notesSlides/notesSlide" <> tshow n <> ".xml"
in Just $
mknode "Relationship" [ ("Id", "rId2")
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesSlide")
@@ -1619,9 +1623,9 @@ slideToSlideRelElement slide = do
slideToSldIdElement :: PandocMonad m => Slide -> P m Element
slideToSldIdElement slide = do
n <- slideNum slide
- let id' = show $ n + 255
+ let id' = tshow $ n + 255
rId <- slideToRelId slide
- return $ mknode "p:sldId" [("id", id'), ("r:id", T.unpack rId)] ()
+ return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] ()
presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element
presentationToSldIdLst (Presentation _ slides) = do
@@ -1646,7 +1650,7 @@ presentationToPresentationElement pres@(Presentation _ slds) = do
notesMasterElem = mknode "p:notesMasterIdLst" []
[ mknode
"p:NotesMasterId"
- [("r:id", "rId" <> show notesMasterRId)]
+ [("r:id", "rId" <> tshow notesMasterRId)]
()
]
@@ -1702,17 +1706,17 @@ docPropsElement docProps = do
,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")]
$
- mknode "dc:title" [] (maybe "" T.unpack $ dcTitle docProps)
+ mknode "dc:title" [] (fromMaybe "" $ dcTitle docProps)
:
- mknode "dc:creator" [] (maybe "" T.unpack $ dcCreator docProps)
+ mknode "dc:creator" [] (fromMaybe "" $ dcCreator docProps)
:
- mknode "cp:keywords" [] (T.unpack keywords)
- : ( [mknode "dc:subject" [] $ maybe "" T.unpack $ dcSubject docProps | isJust (dcSubject docProps)])
- <> ( [mknode "dc:description" [] $ maybe "" T.unpack $ dcDescription docProps | isJust (dcDescription docProps)])
- <> ( [mknode "cp:category" [] $ maybe "" T.unpack $ cpCategory docProps | isJust (cpCategory docProps)])
+ mknode "cp:keywords" [] keywords
+ : ( [mknode "dc:subject" [] $ fromMaybe "" $ dcSubject docProps | isJust (dcSubject docProps)])
+ <> ( [mknode "dc:description" [] $ fromMaybe "" $ dcDescription docProps | isJust (dcDescription docProps)])
+ <> ( [mknode "cp:category" [] $ fromMaybe "" $ cpCategory docProps | isJust (cpCategory docProps)])
<> (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x
- , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x
- ]) (formatTime defaultTimeLocale "%FT%XZ" utctime)
+ , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x
+ ]) (T.pack $ formatTime defaultTimeLocale "%FT%XZ" utctime)
docPropsToEntry :: PandocMonad m => DocProps -> P m Entry
docPropsToEntry docProps = docPropsElement docProps >>=
@@ -1723,8 +1727,8 @@ docCustomPropsElement :: PandocMonad m => DocProps -> P m Element
docCustomPropsElement docProps = do
let mkCustomProp (k, v) pid = mknode "property"
[("fmtid","{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
- ,("pid", show pid)
- ,("name", T.unpack k)] $ mknode "vt:lpwstr" [] (T.unpack v)
+ ,("pid", tshow pid)
+ ,("name", k)] $ mknode "vt:lpwstr" [] v
return $ mknode "Properties"
[("xmlns","http://schemas.openxmlformats.org/officeDocument/2006/custom-properties")
,("xmlns:vt","http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")
@@ -1743,7 +1747,7 @@ viewPropsElement = do
distArchive <- asks envDistArchive
viewPrElement <- parseXml refArchive distArchive "ppt/viewProps.xml"
-- remove "lastView" if it exists:
- let notLastView :: Text.XML.Light.Attr -> Bool
+ let notLastView :: XML.Attr -> Bool
notLastView attr =
qName (attrKey attr) /= "lastView"
return $
@@ -1755,15 +1759,15 @@ makeViewPropsEntry = viewPropsElement >>= elemToEntry "ppt/viewProps.xml"
defaultContentTypeToElem :: DefaultContentType -> Element
defaultContentTypeToElem dct =
mknode "Default"
- [("Extension", T.unpack $ defContentTypesExt dct),
- ("ContentType", T.unpack $ defContentTypesType dct)]
+ [("Extension", defContentTypesExt dct),
+ ("ContentType", defContentTypesType dct)]
()
overrideContentTypeToElem :: OverrideContentType -> Element
overrideContentTypeToElem oct =
mknode "Override"
- [("PartName", overrideContentTypesPart oct),
- ("ContentType", T.unpack $ overrideContentTypesType oct)]
+ [("PartName", T.pack $ overrideContentTypesPart oct),
+ ("ContentType", overrideContentTypesType oct)]
()
contentTypesToElement :: ContentTypes -> Element
@@ -1821,7 +1825,8 @@ getSpeakerNotesFilePaths :: PandocMonad m => P m [FilePath]
getSpeakerNotesFilePaths = do
mp <- asks envSpeakerNotesIdMap
let notesIdNums = M.elems mp
- return $ map (\n -> "ppt/notesSlides/notesSlide" <> show n <> ".xml") notesIdNums
+ return $ map (\n -> "ppt/notesSlides/notesSlide" <> show n <> ".xml")
+ notesIdNums
presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes
presentationToContentTypes p@(Presentation _ slides) = do
@@ -1885,11 +1890,11 @@ getContentType fp
| otherwise = Nothing
-- Kept as String for XML.Light
-autoNumAttrs :: ListAttributes -> [(String, String)]
+autoNumAttrs :: ListAttributes -> [(Text, Text)]
autoNumAttrs (startNum, numStyle, numDelim) =
numAttr <> typeAttr
where
- numAttr = [("startAt", show startNum) | startNum /= 1]
+ numAttr = [("startAt", tshow startNum) | startNum /= 1]
typeAttr = [("type", typeString <> delimString)]
typeString = case numStyle of
Decimal -> "arabic"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-30 09:18:49 +0000