aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/FB2.hs26
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs25
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs1
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs5
-rw-r--r--src/Text/Pandoc/Writers/Ms.hs36
-rw-r--r--src/Text/Pandoc/Writers/Muse.hs49
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs8
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs15
-rw-r--r--src/Text/Pandoc/Writers/RST.hs87
9 files changed, 160 insertions, 92 deletions
diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs
index 7fcb50b05..a46011a8f 100644
--- a/src/Text/Pandoc/Writers/FB2.hs
+++ b/src/Text/Pandoc/Writers/FB2.hs
@@ -118,6 +118,9 @@ description meta' = do
bt <- booktitle meta'
let as = authors meta'
dd <- docdate meta'
+ annotation <- case lookupMeta "abstract" meta' of
+ Just (MetaBlocks bs) -> (list . el "annotation") <$> cMapM blockToXml bs
+ _ -> pure mempty
let lang = case lookupMeta "lang" meta' of
Just (MetaInlines [Str s]) -> [el "lang" $ iso639 s]
Just (MetaString s) -> [el "lang" $ iso639 s]
@@ -132,7 +135,7 @@ description meta' = do
Just (MetaString s) -> coverimage s
_ -> return []
return $ el "description"
- [ el "title-info" (genre : (bt ++ as ++ dd ++ lang))
+ [ el "title-info" (genre : (bt ++ annotation ++ as ++ dd ++ lang))
, el "document-info" (el "program-used" "pandoc" : coverpage)
]
@@ -311,9 +314,6 @@ isMimeType s =
footnoteID :: Int -> String
footnoteID i = "n" ++ show i
-linkID :: Int -> String
-linkID i = "l" ++ show i
-
-- | Convert a block-level Pandoc's element to FictionBook XML representation.
blockToXml :: PandocMonad m => Block -> FBM m [Content]
blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2
@@ -452,23 +452,9 @@ toXml (Math _ formula) = insertMath InlineImage formula
toXml il@(RawInline _ _) = do
report $ InlineNotRendered il
return [] -- raw TeX and raw HTML are suppressed
-toXml (Link _ text (url,ttl)) = do
- fns <- footnotes `liftM` get
- let n = 1 + length fns
- let ln_id = linkID n
- let ln_ref = list . el "sup" . txt $ "[" ++ show n ++ "]"
+toXml (Link _ text (url,_)) = do
ln_text <- cMapM toXml text
- let ln_desc =
- let ttl' = dropWhile isSpace ttl
- in if null ttl'
- then list . el "p" $ el "code" url
- else list . el "p" $ [ txt (ttl' ++ ": "), el "code" url ]
- modify (\s -> s { footnotes = (n, ln_id, ln_desc) : fns })
- return $ ln_text ++
- [ el "a"
- ( [ attr ("l","href") ('#':ln_id)
- , uattr "type" "note" ]
- , ln_ref) ]
+ return [ el "a" ( [ attr ("l","href") url ], ln_text) ]
toXml img@Image{} = insertImage InlineImage img
toXml (Note bs) = do
fns <- footnotes `liftM` get
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index d1a366445..762bbd0e5 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -260,10 +260,6 @@ pandocToHtml opts (Pandoc meta blocks) = do
notes <- footnoteSection opts (reverse (stNotes st))
let thebody = blocks' >> notes
let math = case writerHTMLMathMethod opts of
- LaTeXMathML (Just url) ->
- H.script ! A.src (toValue url)
- ! A.type_ "text/javascript"
- $ mempty
MathJax url
| slideVariant /= RevealJsSlides ->
-- mathjax is handled via a special plugin in revealjs
@@ -274,10 +270,6 @@ pandocToHtml opts (Pandoc meta blocks) = do
preEscapedString
"MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);"
_ -> mempty
- JsMath (Just url) ->
- H.script ! A.src (toValue url)
- ! A.type_ "text/javascript"
- $ mempty
KaTeX url -> do
H.script !
A.src (toValue $ url ++ "katex.min.js") $ mempty
@@ -1024,19 +1016,6 @@ inlineToHtml opts inline = do
let mathClass = toValue $ ("math " :: String) ++
if t == InlineMath then "inline" else "display"
case writerHTMLMathMethod opts of
- LaTeXMathML _ ->
- -- putting LaTeXMathML in container with class "LaTeX" prevents
- -- non-math elements on the page from being treated as math by
- -- the javascript
- return $ H.span ! A.class_ "LaTeX" $
- case t of
- InlineMath -> toHtml ("$" ++ str ++ "$")
- DisplayMath -> toHtml ("$$" ++ str ++ "$$")
- JsMath _ -> do
- let m = preEscapedString str
- return $ case t of
- InlineMath -> H.span ! A.class_ mathClass $ m
- DisplayMath -> H.div ! A.class_ mathClass $ m
WebTeX url -> do
let imtag = if html5 then H5.img else H.img
let m = imtag ! A.style "vertical-align:middle"
@@ -1047,10 +1026,6 @@ inlineToHtml opts inline = do
return $ case t of
InlineMath -> m
DisplayMath -> brtag >> m >> brtag
- GladTeX ->
- return $ case t of
- InlineMath -> preEscapedString $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>"
- DisplayMath -> preEscapedString $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>"
MathML -> do
let conf = useShortEmptyTags (const False)
defaultConfigPP
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index f354bc0a2..d9868b7cd 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -678,6 +678,7 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
let enum = text $ "enum" ++ map toLower (toRomanNumeral oldlevel)
let stylecommand
| numstyle == DefaultStyle && numdelim == DefaultDelim = empty
+ | beamer && numstyle == Decimal && numdelim == Period = empty
| beamer = brackets (todelim exemplar)
| otherwise = "\\def" <> "\\label" <> enum <>
braces (todelim $ tostyle enum)
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 3bfa8a012..075858e5e 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -732,7 +732,10 @@ pandocTable opts multiline headless aligns widths rawHeaders rawRows = do
then empty
else border <> cr <> head'
let body = if multiline
- then vsep rows'
+ then vsep rows' $$
+ if length rows' < 2
+ then blankline -- #4578
+ else empty
else vcat rows'
let bottom = if headless
then underline
diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs
index 600b71c40..16a66c85b 100644
--- a/src/Text/Pandoc/Writers/Ms.hs
+++ b/src/Text/Pandoc/Writers/Ms.hs
@@ -40,7 +40,7 @@ module Text.Pandoc.Writers.Ms ( writeMs ) where
import Prelude
import Control.Monad.State.Strict
import Data.Char (isLower, isUpper, toUpper, ord)
-import Data.List (intercalate, intersperse, sort)
+import Data.List (intercalate, intersperse)
import qualified Data.Map as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text)
@@ -68,6 +68,7 @@ data WriterState = WriterState { stHasInlineMath :: Bool
, stNotes :: [Note]
, stSmallCaps :: Bool
, stHighlighting :: Bool
+ , stInHeader :: Bool
, stFontFeatures :: Map.Map Char Bool
}
@@ -77,6 +78,7 @@ defaultWriterState = WriterState{ stHasInlineMath = False
, stNotes = []
, stSmallCaps = False
, stHighlighting = False
+ , stInHeader = False
, stFontFeatures = Map.fromList [
('I',False)
, ('B',False)
@@ -135,7 +137,6 @@ msEscapes = Map.fromList
[ ('\160', "\\~")
, ('\'', "\\[aq]")
, ('`', "\\`")
- , ('\8217', "'")
, ('"', "\\[dq]")
, ('\x2014', "\\[em]")
, ('\x2013', "\\[en]")
@@ -218,11 +219,16 @@ blockToMs :: PandocMonad m
-> Block -- ^ Block element
-> MS m Doc
blockToMs _ Null = return empty
-blockToMs opts (Div _ bs) = do
+blockToMs opts (Div (ident,_,_) bs) = do
+ let anchor = if null ident
+ then empty
+ else nowrap $
+ text ".pdfhref M "
+ <> doubleQuotes (text (toAscii ident))
setFirstPara
res <- blockListToMs opts bs
setFirstPara
- return res
+ return $ anchor $$ res
blockToMs opts (Plain inlines) =
liftM vcat $ mapM (inlineListToMs' opts) $ splitSentences inlines
blockToMs opts (Para [Image attr alt (src,_tit)])
@@ -260,7 +266,9 @@ blockToMs _ HorizontalRule = do
return $ text ".HLINE"
blockToMs opts (Header level (ident,classes,_) inlines) = do
setFirstPara
+ modify $ \st -> st{ stInHeader = True }
contents <- inlineListToMs' opts $ map breakToSpace inlines
+ modify $ \st -> st{ stInHeader = False }
let (heading, secnum) = if writerNumberSections opts &&
"unnumbered" `notElem` classes
then (".NH", "\\*[SN]")
@@ -555,8 +563,15 @@ handleNote opts bs = do
fontChange :: PandocMonad m => MS m Doc
fontChange = do
features <- gets stFontFeatures
- let filling = sort [c | (c,True) <- Map.toList features]
- return $ text $ "\\f[" ++ filling ++ "]"
+ inHeader <- gets stInHeader
+ let filling = ['C' | fromMaybe False $ Map.lookup 'C' features] ++
+ ['B' | inHeader ||
+ fromMaybe False (Map.lookup 'B' features)] ++
+ ['I' | fromMaybe False $ Map.lookup 'I' features]
+ return $
+ if null filling
+ then text "\\f[R]"
+ else text $ "\\f[" ++ filling ++ "]"
withFontFeature :: PandocMonad m => Char -> MS m Doc -> MS m Doc
withFontFeature c action = do
@@ -641,7 +656,10 @@ highlightCode opts attr str =
modify (\st -> st{ stHighlighting = True })
return h
+-- This is used for PDF anchors.
toAscii :: String -> String
-toAscii = concatMap (\c -> case toAsciiChar c of
- Nothing -> 'u':show (ord c)
- Just c' -> [c'])
+toAscii = concatMap
+ (\c -> case toAsciiChar c of
+ Nothing -> '_':'u':show (ord c) ++ "_"
+ Just '/' -> '_':'u':show (ord c) ++ "_" -- see #4515
+ Just c' -> [c'])
diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index e9cf6d433..6ed6ed1ca 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -71,8 +71,9 @@ data WriterEnv =
, envTopLevel :: Bool
, envInsideBlock :: Bool
, envInlineStart :: Bool
- , envInsideLinkDescription :: Bool -- Escape ] if True
+ , envInsideLinkDescription :: Bool -- ^ Escape ] if True
, envAfterSpace :: Bool
+ , envOneLine :: Bool -- ^ True if newlines are not allowed
}
data WriterState =
@@ -86,7 +87,7 @@ instance Default WriterState
}
evalMuse :: PandocMonad m => Muse m a -> WriterEnv -> WriterState -> m a
-evalMuse document env st = evalStateT (runReaderT document env) st
+evalMuse document env = evalStateT $ runReaderT document env
-- | Convert Pandoc to Muse.
writeMuse :: PandocMonad m
@@ -100,7 +101,8 @@ writeMuse opts document =
, envInsideBlock = False
, envInlineStart = True
, envInsideLinkDescription = False
- , envAfterSpace = True
+ , envAfterSpace = False
+ , envOneLine = False
}
-- | Return Muse representation of document.
@@ -173,7 +175,7 @@ blockToMuse (Para inlines) = do
contents <- inlineListToMuse' inlines
return $ contents <> blankline
blockToMuse (LineBlock lns) = do
- lns' <- mapM inlineListToMuse lns
+ lns' <- local (\env -> env { envOneLine = True }) $ mapM inlineListToMuse lns
return $ nowrap $ vcat (map (text "> " <>) lns') <> blankline
blockToMuse (CodeBlock (_,_,_) str) =
return $ "<example>" $$ text str $$ "</example>" $$ blankline
@@ -221,7 +223,7 @@ blockToMuse (DefinitionList items) = do
=> ([Inline], [[Block]])
-> Muse m Doc
definitionListItemToMuse (label, defs) = do
- label' <- inlineListToMuse' label
+ label' <- local (\env -> env { envOneLine = True, envAfterSpace = True }) $ inlineListToMuse' label
contents <- vcat <$> mapM descriptionToMuse defs
let ind = offset label'
return $ hang ind label' contents
@@ -231,8 +233,7 @@ blockToMuse (DefinitionList items) = do
descriptionToMuse desc = hang 4 " :: " <$> blockListToMuse desc
blockToMuse (Header level (ident,_,_) inlines) = do
opts <- asks envOptions
- contents <- inlineListToMuse inlines
-
+ contents <- local (\env -> env { envOneLine = True }) $ inlineListToMuse' inlines
ids <- gets stIds
let autoId = uniqueIdent inlines ids
modify $ \st -> st{ stIds = Set.insert autoId ids }
@@ -275,7 +276,7 @@ blockToMuse Null = return empty
notesToMuse :: PandocMonad m
=> Notes
-> Muse m Doc
-notesToMuse notes = vsep <$> (zipWithM noteToMuse [1 ..] notes)
+notesToMuse notes = vsep <$> zipWithM noteToMuse [1 ..] notes
-- | Return Muse representation of a note.
noteToMuse :: PandocMonad m
@@ -306,8 +307,7 @@ startsWithMarker _ [] = False
-- | Escape special characters for Muse if needed.
containsFootnotes :: String -> Bool
-containsFootnotes st =
- p st
+containsFootnotes = p
where p ('[':xs) = q xs || p xs
p (_:xs) = p xs
p "" = False
@@ -323,7 +323,7 @@ containsFootnotes st =
conditionalEscapeString :: Bool -> String -> String
conditionalEscapeString isInsideLinkDescription s =
- if any (`elem` ("#*<=>|" :: String)) s ||
+ if any (`elem` ("#*<=|" :: String)) s ||
"::" `isInfixOf` s ||
"~~" `isInfixOf` s ||
"[[" `isInfixOf` s ||
@@ -395,17 +395,20 @@ urlEscapeBrackets (x:xs) = x:urlEscapeBrackets xs
urlEscapeBrackets [] = []
isHorizontalRule :: String -> Bool
-isHorizontalRule s =
- ((length xs) >= 4) && null ys
- where (xs, ys) = span (== '-') s
+isHorizontalRule s = length s >= 4 && all (== '-') s
+
+startsWithSpace :: String -> Bool
+startsWithSpace (x:_) = isSpace x
+startsWithSpace [] = False
fixOrEscape :: Bool -> Inline -> Bool
fixOrEscape sp (Str "-") = sp
fixOrEscape sp (Str ";") = not sp
+fixOrEscape _ (Str ">") = True
fixOrEscape sp (Str s) = (sp && (startsWithMarker isDigit s ||
startsWithMarker isAsciiLower s ||
startsWithMarker isAsciiUpper s))
- || isHorizontalRule s
+ || isHorizontalRule s || startsWithSpace s
fixOrEscape _ Space = True
fixOrEscape _ SoftBreak = True
fixOrEscape _ _ = False
@@ -433,14 +436,15 @@ renderInlineList (x:xs) = do
-- | Normalize and convert list of Pandoc inline elements to Muse.
inlineListToMuse'' :: PandocMonad m
- => Bool
- -> [Inline]
- -> Muse m Doc
+ => Bool
+ -> [Inline]
+ -> Muse m Doc
inlineListToMuse'' start lst = do
lst' <- (normalizeInlineList . fixNotes) <$> preprocessInlineList (map (removeKeyValues . replaceSmallCaps) lst)
topLevel <- asks envTopLevel
+ afterSpace <- asks envAfterSpace
local (\env -> env { envInlineStart = start
- , envAfterSpace = start && not topLevel
+ , envAfterSpace = afterSpace || (start && not topLevel)
}) $ renderInlineList lst'
inlineListToMuse' :: PandocMonad m => [Inline] -> Muse m Doc
@@ -487,11 +491,14 @@ inlineToMuse Math{} =
fail "Math should be expanded before normalization"
inlineToMuse (RawInline (Format f) str) =
return $ "<literal style=\"" <> text f <> "\">" <> text str <> "</literal>"
-inlineToMuse LineBreak = return $ "<br>" <> cr
+inlineToMuse LineBreak = do
+ oneline <- asks envOneLine
+ return $ if oneline then "<br>" else "<br>" <> cr
inlineToMuse Space = return space
inlineToMuse SoftBreak = do
+ oneline <- asks envOneLine
wrapText <- asks $ writerWrapText . envOptions
- return $ if wrapText == WrapPreserve then cr else space
+ return $ if not oneline && wrapText == WrapPreserve then cr else space
inlineToMuse (Link _ txt (src, _)) =
case txt of
[Str x] | escapeURI x == src ->
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index dc5f1c9a9..865ef1efc 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -58,7 +58,7 @@ import Text.Pandoc.MIME
import qualified Data.ByteString.Lazy as BL
import Text.Pandoc.Writers.OOXML
import qualified Data.Map as M
-import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, isJust, maybeToList, catMaybes)
+import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes)
import Text.Pandoc.ImageSize
import Control.Applicative ((<|>))
import System.FilePath.Glob
@@ -328,10 +328,8 @@ presHasSpeakerNotes :: Presentation -> Bool
presHasSpeakerNotes (Presentation _ slides) = not $ all (mempty ==) $ map slideSpeakerNotes slides
curSlideHasSpeakerNotes :: PandocMonad m => P m Bool
-curSlideHasSpeakerNotes = do
- sldId <- asks envCurSlideId
- notesIdMap <- asks envSpeakerNotesIdMap
- return $ isJust $ M.lookup sldId notesIdMap
+curSlideHasSpeakerNotes =
+ M.member <$> asks envCurSlideId <*> asks envSpeakerNotesIdMap
--------------------------------------------------
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index c49943bcf..e14476b16 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -376,9 +376,20 @@ inlineToParElems (Note blks) = do
modify $ \st -> st { stNoteIds = M.insert curNoteId blks notes }
local (\env -> env{envRunProps = (envRunProps env){rLink = Just $ InternalTarget endNotesSlideId}}) $
inlineToParElems $ Superscript [Str $ show curNoteId]
-inlineToParElems (Span _ ils) = concatMapM inlineToParElems ils
+inlineToParElems (Span _ ils) = inlinesToParElems ils
+inlineToParElems (Quoted quoteType ils) =
+ inlinesToParElems $ [Str open] ++ ils ++ [Str close]
+ where (open, close) = case quoteType of
+ SingleQuote -> ("\x2018", "\x2019")
+ DoubleQuote -> ("\x201C", "\x201D")
inlineToParElems (RawInline _ _) = return []
-inlineToParElems _ = return []
+inlineToParElems (Cite _ ils) = inlinesToParElems ils
+-- Note: we shouldn't reach this, because images should be handled at
+-- the shape level, but should that change in the future, we render
+-- the alt text.
+inlineToParElems (Image _ alt _) = inlinesToParElems alt
+
+
isListType :: Block -> Bool
isListType (OrderedList _ _) = True
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 74fc4dca4..084615357 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -31,7 +31,7 @@ Conversion of 'Pandoc' documents to reStructuredText.
reStructuredText: <http://docutils.sourceforge.net/rst.html>
-}
-module Text.Pandoc.Writers.RST ( writeRST ) where
+module Text.Pandoc.Writers.RST ( writeRST, flatten ) where
import Prelude
import Control.Monad.State.Strict
import Data.Char (isSpace, toLower)
@@ -263,7 +263,6 @@ blockToRST (Header level (name,classes,_) inlines) = do
return $ nowrap $ hang 3 ".. " (rub $$ name' $$ cls) $$ blankline
blockToRST (CodeBlock (_,classes,kvs) str) = do
opts <- gets stOptions
- let tabstop = writerTabStop opts
let startnum = maybe "" (\x -> " " <> text x) $ lookup "startFrom" kvs
let numberlines = if "numberLines" `elem` classes
then " :number-lines:" <> startnum
@@ -276,11 +275,10 @@ blockToRST (CodeBlock (_,classes,kvs) str) = do
c `notElem` ["sourceCode","literate","numberLines"]] of
[] -> "::"
(lang:_) -> (".. code:: " <> text lang) $$ numberlines)
- $+$ nest tabstop (text str) $$ blankline
+ $+$ nest 3 (text str) $$ blankline
blockToRST (BlockQuote blocks) = do
- tabstop <- gets $ writerTabStop . stOptions
contents <- blockListToRST blocks
- return $ nest tabstop contents <> blankline
+ return $ nest 3 contents <> blankline
blockToRST (Table caption aligns widths headers rows) = do
caption' <- inlineListToRST caption
let blocksToDoc opts bs = do
@@ -338,8 +336,7 @@ definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m Doc
definitionListItemToRST (label, defs) = do
label' <- inlineListToRST label
contents <- liftM vcat $ mapM blockListToRST defs
- tabstop <- gets $ writerTabStop . stOptions
- return $ nowrap label' $$ nest tabstop (nestle contents <> cr)
+ return $ nowrap label' $$ nest 3 (nestle contents <> cr)
-- | Format a list of lines as line block.
linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m Doc
@@ -380,8 +377,10 @@ blockListToRST :: PandocMonad m
blockListToRST = blockListToRST' False
transformInlines :: [Inline] -> [Inline]
-transformInlines = stripLeadingTrailingSpace . insertBS
- . filter hasContents . removeSpaceAfterDisplayMath
+transformInlines = insertBS .
+ filter hasContents .
+ removeSpaceAfterDisplayMath .
+ concatMap (transformNested . flatten)
where -- empty inlines are not valid RST syntax
hasContents :: Inline -> Bool
hasContents (Str "") = False
@@ -415,6 +414,8 @@ transformInlines = stripLeadingTrailingSpace . insertBS
x : insertBS (y : zs)
insertBS (x:ys) = x : insertBS ys
insertBS [] = []
+ transformNested :: [Inline] -> [Inline]
+ transformNested = map (mapNested stripLeadingTrailingSpace)
surroundComplex :: Inline -> Inline -> Bool
surroundComplex (Str s@(_:_)) (Str s'@(_:_)) =
case (last s, head s') of
@@ -452,6 +453,74 @@ transformInlines = stripLeadingTrailingSpace . insertBS
isComplex (Span _ (x:_)) = isComplex x
isComplex _ = False
+-- | Flattens nested inlines. Extracts nested inlines and goes through
+-- them either collapsing them in the outer inline container or
+-- pulling them out of it
+flatten :: Inline -> [Inline]
+flatten outer = combineAll $ dropInlineParent outer
+ where combineAll = foldl combine []
+
+ combine :: [Inline] -> Inline -> [Inline]
+ combine f i =
+ case (outer, i) of
+ -- quotes are not rendered using RST inlines, so we can keep
+ -- them and they will be readable and parsable
+ (Quoted _ _, _) -> keep f i
+ (_, Quoted _ _) -> keep f i
+ -- parent inlines would prevent links from being correctly
+ -- parsed, in this case we prioritise the content over the
+ -- style
+ (_, Link _ _ _) -> emerge f i
+ -- always give priority to strong text over emphasis
+ (Emph _, Strong _) -> emerge f i
+ -- drop all other nested styles
+ (_, _) -> collapse f i
+
+ emerge f i = f <> [i]
+ keep f i = appendToLast f [i]
+ collapse f i = appendToLast f $ dropInlineParent i
+
+ appendToLast :: [Inline] -> [Inline] -> [Inline]
+ appendToLast [] toAppend = [setInlineChildren outer toAppend]
+ appendToLast flattened toAppend
+ | isOuter lastFlat = init flattened <> [appendTo lastFlat toAppend]
+ | otherwise = flattened <> [setInlineChildren outer toAppend]
+ where lastFlat = last flattened
+ appendTo o i = mapNested (<> i) o
+ isOuter i = emptyParent i == emptyParent outer
+ emptyParent i = setInlineChildren i []
+
+mapNested :: ([Inline] -> [Inline]) -> Inline -> Inline
+mapNested f i = setInlineChildren i (f (dropInlineParent i))
+
+dropInlineParent :: Inline -> [Inline]
+dropInlineParent (Link _ i _) = i
+dropInlineParent (Emph i) = i
+dropInlineParent (Strong i) = i
+dropInlineParent (Strikeout i) = i
+dropInlineParent (Superscript i) = i
+dropInlineParent (Subscript i) = i
+dropInlineParent (SmallCaps i) = i
+dropInlineParent (Cite _ i) = i
+dropInlineParent (Image _ i _) = i
+dropInlineParent (Span _ i) = i
+dropInlineParent (Quoted _ i) = i
+dropInlineParent i = [i] -- not a parent, like Str or Space
+
+setInlineChildren :: Inline -> [Inline] -> Inline
+setInlineChildren (Link a _ t) i = Link a i t
+setInlineChildren (Emph _) i = Emph i
+setInlineChildren (Strong _) i = Strong i
+setInlineChildren (Strikeout _) i = Strikeout i
+setInlineChildren (Superscript _) i = Superscript i
+setInlineChildren (Subscript _) i = Subscript i
+setInlineChildren (SmallCaps _) i = SmallCaps i
+setInlineChildren (Quoted q _) i = Quoted q i
+setInlineChildren (Cite c _) i = Cite c i
+setInlineChildren (Image a _ t) i = Image a i t
+setInlineChildren (Span a _) i = Span a i
+setInlineChildren leaf _ = leaf
+
inlineListToRST :: PandocMonad m => [Inline] -> RST m Doc
inlineListToRST = writeInlines . walk transformInlines
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 01:33:19 +0000