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/AsciiDoc.hs8
-rw-r--r--src/Text/Pandoc/Writers/CommonMark.hs3
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs40
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs2
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs26
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs11
-rw-r--r--src/Text/Pandoc/Writers/DokuWiki.hs7
-rw-r--r--src/Text/Pandoc/Writers/FB2.hs4
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs9
-rw-r--r--src/Text/Pandoc/Writers/Haddock.hs2
-rw-r--r--src/Text/Pandoc/Writers/ICML.hs6
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs19
-rw-r--r--src/Text/Pandoc/Writers/Man.hs3
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs257
-rw-r--r--src/Text/Pandoc/Writers/MediaWiki.hs3
-rw-r--r--src/Text/Pandoc/Writers/Native.hs2
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs2
-rw-r--r--src/Text/Pandoc/Writers/Org.hs13
-rw-r--r--src/Text/Pandoc/Writers/RST.hs11
-rw-r--r--src/Text/Pandoc/Writers/RTF.hs2
-rw-r--r--src/Text/Pandoc/Writers/TEI.hs36
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs3
-rw-r--r--src/Text/Pandoc/Writers/Textile.hs3
-rw-r--r--src/Text/Pandoc/Writers/ZimWiki.hs6
24 files changed, 314 insertions, 164 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs
index 0dfbd705e..c7097c368 100644
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/src/Text/Pandoc/Writers/AsciiDoc.hs
@@ -137,6 +137,13 @@ blockToAsciiDoc opts (Para inlines) = do
then text "\\"
else empty
return $ esc <> contents <> blankline
+blockToAsciiDoc opts (LineBlock lns) = do
+ let docify line = if null line
+ then return blankline
+ else inlineListToAsciiDoc opts line
+ let joinWithLinefeeds = nowrap . mconcat . intersperse cr
+ contents <- joinWithLinefeeds <$> mapM docify lns
+ return $ "[verse]" $$ text "--" $$ contents $$ text "--" $$ blankline
blockToAsciiDoc _ (RawBlock f s)
| f == "asciidoc" = return $ text s
| otherwise = return empty
@@ -459,4 +466,3 @@ inlineToAsciiDoc opts (Span (ident,_,_) ils) = do
let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]")
contents <- inlineListToAsciiDoc opts ils
return $ identifier <> contents
-
diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs
index 262f491a8..c6509fe92 100644
--- a/src/Text/Pandoc/Writers/CommonMark.hs
+++ b/src/Text/Pandoc/Writers/CommonMark.hs
@@ -33,7 +33,7 @@ module Text.Pandoc.Writers.CommonMark (writeCommonMark) where
import Text.Pandoc.Writers.HTML (writeHtmlString)
import Text.Pandoc.Definition
-import Text.Pandoc.Shared (isTightList)
+import Text.Pandoc.Shared (isTightList, linesToPara)
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Options
@@ -94,6 +94,7 @@ blocksToNodes = foldr blockToNodes []
blockToNodes :: Block -> [Node] -> [Node]
blockToNodes (Plain xs) = (node PARAGRAPH (inlinesToNodes xs) :)
blockToNodes (Para xs) = (node PARAGRAPH (inlinesToNodes xs) :)
+blockToNodes (LineBlock lns) = blockToNodes $ linesToPara lns
blockToNodes (CodeBlock (_,classes,_) xs) =
(node (CODE_BLOCK (T.pack (unwords classes)) (T.pack xs)) [] :)
blockToNodes (RawBlock fmt xs)
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index 8d54d62bd..6d66ce48c 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -83,9 +83,10 @@ pandocToConTeXt options (Pandoc meta blocks) = do
]
let context = defField "toc" (writerTableOfContents options)
$ defField "placelist" (intercalate ("," :: String) $
- take (writerTOCDepth options + if writerChapters options
- then 0
- else 1)
+ take (writerTOCDepth options +
+ if writerTopLevelDivision options < Section
+ then 0
+ else 1)
["chapter","section","subsection","subsubsection",
"subsubsubsection","subsubsubsubsection"])
$ defField "body" main
@@ -163,6 +164,9 @@ blockToConTeXt (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do
blockToConTeXt (Para lst) = do
contents <- inlineListToConTeXt lst
return $ contents <> blankline
+blockToConTeXt (LineBlock lns) = do
+ doclines <- nowrap . vcat <$> mapM inlineListToConTeXt lns
+ return $ "\\startlines" $$ doclines $$ "\\stoplines" <> blankline
blockToConTeXt (BlockQuote lst) = do
contents <- blockListToConTeXt lst
return $ "\\startblockquote" $$ nest 0 contents $$ "\\stopblockquote" <> blankline
@@ -409,7 +413,7 @@ inlineToConTeXt (Span (_,_,kvs) ils) = do
Nothing -> txt
fmap (wrapLang . wrapDir) $ inlineListToConTeXt ils
--- | Craft the section header, inserting the secton reference, if supplied.
+-- | Craft the section header, inserting the section reference, if supplied.
sectionHeader :: Attr
-> Int
-> [Inline]
@@ -418,21 +422,26 @@ sectionHeader (ident,classes,_) hdrLevel lst = do
contents <- inlineListToConTeXt lst
st <- get
let opts = stOptions st
- let level' = if writerChapters opts then hdrLevel - 1 else hdrLevel
+ let level' = case writerTopLevelDivision opts of
+ Part -> hdrLevel - 2
+ Chapter -> hdrLevel - 1
+ Section -> hdrLevel
let ident' = toLabel ident
let (section, chapter) = if "unnumbered" `elem` classes
then (text "subject", text "title")
else (text "section", text "chapter")
- return $ if level' >= 1 && level' <= 5
- then char '\\'
- <> text (concat (replicate (level' - 1) "sub"))
- <> section
- <> (if (not . null) ident' then brackets (text ident') else empty)
- <> braces contents
- <> blankline
- else if level' == 0
- then char '\\' <> chapter <> braces contents
- else contents <> blankline
+ return $ case level' of
+ -1 -> text "\\part" <> braces contents
+ 0 -> char '\\' <> chapter <> braces contents
+ n | n >= 1 && n <= 5 -> char '\\'
+ <> text (concat (replicate (n - 1) "sub"))
+ <> section
+ <> (if (not . null) ident'
+ then brackets (text ident')
+ else empty)
+ <> braces contents
+ <> blankline
+ _ -> contents <> blankline
fromBcp47' :: String -> String
fromBcp47' = fromBcp47 . splitBy (=='-')
@@ -467,4 +476,3 @@ fromBcp47 x = fromIso $ head x
fromIso "vi" = "vn"
fromIso "zh" = "cn"
fromIso l = l
-
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index d69eaaa64..631241724 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -227,6 +227,8 @@ blockToCustom lua (Para [Image attr txt (src,tit)]) =
blockToCustom lua (Para inlines) = callfunc lua "Para" inlines
+blockToCustom lua (LineBlock linesList) = callfunc lua "LineBlock" linesList
+
blockToCustom lua (RawBlock format str) =
callfunc lua "RawBlock" format str
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 8bb0810e4..c28056153 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -79,12 +79,16 @@ writeDocbook opts (Pandoc meta blocks) =
colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- render' = render colwidth
- opts' = if "/book>" `isSuffixOf`
- (trimr $ writerTemplate opts)
- then opts{ writerChapters = True }
- else opts
- startLvl = if writerChapters opts' then 0 else 1
+ render' = render colwidth
+ opts' = if ("/book>" `isSuffixOf` (trimr $ writerTemplate opts) &&
+ writerTopLevelDivision opts >= Section)
+ then opts{ writerTopLevelDivision = Chapter }
+ else opts
+ -- The numbering here follows LaTeX's internal numbering
+ startLvl = case writerTopLevelDivision opts' of
+ Part -> -1
+ Chapter -> 0
+ Section -> 1
auths' = map (authorToDocbook opts) $ docAuthors meta
meta' = B.setMeta "author" auths' meta
Just metadata = metaToJSON opts
@@ -111,11 +115,12 @@ elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) =
then [Blk (Para [])]
else elements
tag = case lvl of
- n | n == 0 -> "chapter"
- | n >= 1 && n <= 5 -> if writerDocbook5 opts
+ -1 -> "part"
+ 0 -> "chapter"
+ n | n >= 1 && n <= 5 -> if writerDocbook5 opts
then "section"
else "sect" ++ show n
- | otherwise -> "simplesect"
+ _ -> "simplesect"
idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')]
nsAttr = if writerDocbook5 opts && lvl == 0 then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")]
else []
@@ -198,6 +203,8 @@ blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) =
blockToDocbook opts (Para lst)
| hasLineBreaks lst = flush $ nowrap $ inTagsSimple "literallayout" $ inlinesToDocbook opts lst
| otherwise = inTagsIndented "para" $ inlinesToDocbook opts lst
+blockToDocbook opts (LineBlock lns) =
+ blockToDocbook opts $ linesToPara lns
blockToDocbook opts (BlockQuote blocks) =
inTagsIndented "blockquote" $ blocksToDocbook opts blocks
blockToDocbook _ (CodeBlock (_,classes,_) str) =
@@ -385,4 +392,3 @@ idAndRole (id',cls,_) = ident ++ role
role = if null cls
then []
else [("role", unwords cls)]
-
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index a006773d6..dfa011784 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -275,7 +275,7 @@ writeDocx opts doc@(Pandoc meta _) = do
}
- ((contents, footnotes), st) <- runStateT
+ ((contents, footnotes), st) <- runStateT
(runReaderT
(writeOpenXML opts{writerWrapText = WrapNone} doc')
env)
@@ -446,7 +446,7 @@ writeDocx opts doc@(Pandoc meta _) = do
let newstyles = map newParaPropToOpenXml newDynamicParaProps ++
map newTextPropToOpenXml newDynamicTextProps ++
- (styleToOpenXml styleMaps $ writerHighlightStyle opts)
+ (styleToOpenXml styleMaps $ writerHighlightStyle opts)
let styledoc' = styledoc{ elContent = modifyContent (elContent styledoc) }
where
modifyContent
@@ -859,6 +859,7 @@ blockToOpenXML' opts (Para lst) = do
modify $ \s -> s { stFirstPara = False }
contents <- inlinesToOpenXML opts lst
return [mknode "w:p" [] (paraProps' ++ contents)]
+blockToOpenXML' opts (LineBlock lns) = blockToOpenXML opts $ linesToPara lns
blockToOpenXML' _ (RawBlock format str)
| format == Format "openxml" = return [ x | Elem x <- parseXML str ]
| otherwise = return []
@@ -1032,7 +1033,7 @@ setFirstPara = modify $ \s -> s { stFirstPara = True }
-- | Convert an inline element to OpenXML.
inlineToOpenXML :: WriterOptions -> Inline -> WS [Element]
-inlineToOpenXML opts il = withDirection $ inlineToOpenXML' opts il
+inlineToOpenXML opts il = withDirection $ inlineToOpenXML' opts il
inlineToOpenXML' :: WriterOptions -> Inline -> WS [Element]
inlineToOpenXML' _ (Str str) = formattedString str
@@ -1286,7 +1287,7 @@ withDirection x = do
textProps <- asks envTextProperties
-- We want to clean all bidirection (bidi) and right-to-left (rtl)
-- properties from the props first. This is because we don't want
- -- them to stack up.
+ -- them to stack up.
let paraProps' = filter (\e -> (qName . elName) e /= "bidi") paraProps
textProps' = filter (\e -> (qName . elName) e /= "rtl") textProps
if isRTL
@@ -1298,5 +1299,3 @@ withDirection x = do
else flip local x $ \env -> env { envParaProperties = paraProps'
, envTextProperties = textProps'
}
-
-
diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs
index 56e2b9027..402b74bc3 100644
--- a/src/Text/Pandoc/Writers/DokuWiki.hs
+++ b/src/Text/Pandoc/Writers/DokuWiki.hs
@@ -45,8 +45,8 @@ import Text.Pandoc.Options ( WriterOptions(
, writerStandalone
, writerTemplate
, writerWrapText), WrapOption(..) )
-import Text.Pandoc.Shared ( escapeURI, removeFormatting, camelCaseToHyphenated
- , trimr, normalize, substitute )
+import Text.Pandoc.Shared ( escapeURI, linesToPara, removeFormatting
+ , camelCaseToHyphenated, trimr, normalize, substitute )
import Text.Pandoc.Writers.Shared ( defField, metaToJSON )
import Text.Pandoc.ImageSize
import Text.Pandoc.Templates ( renderTemplate' )
@@ -147,6 +147,9 @@ blockToDokuWiki opts (Para inlines) = do
then "<HTML><p></HTML>" ++ contents ++ "<HTML></p></HTML>"
else contents ++ if null indent then "\n" else ""
+blockToDokuWiki opts (LineBlock lns) =
+ blockToDokuWiki opts $ linesToPara lns
+
blockToDokuWiki _ (RawBlock f str)
| f == Format "dokuwiki" = return str
-- See https://www.dokuwiki.org/wiki:syntax
diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs
index 80296e111..6f47dbcd2 100644
--- a/src/Text/Pandoc/Writers/FB2.hs
+++ b/src/Text/Pandoc/Writers/FB2.hs
@@ -46,7 +46,8 @@ import qualified Text.XML.Light.Cursor as XC
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)
-import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize)
+import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize,
+ linesToPara)
-- | Data to be written at the end of the document:
-- (foot)notes, URLs, references, images.
@@ -323,6 +324,7 @@ blockToXml (RawBlock _ s) = return . spaceBeforeAfter .
map (el "p" . el "code") . lines $ s
blockToXml (Div _ bs) = cMapM blockToXml bs
blockToXml (BlockQuote bs) = liftM (list . el "cite") $ cMapM blockToXml bs
+blockToXml (LineBlock lns) = blockToXml $ linesToPara lns
blockToXml (OrderedList a bss) = do
state <- get
let pmrk = parentListMarker state
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index db8c301ef..2d0df4dbe 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -463,6 +463,13 @@ blockToHtml opts (Para [Image attr txt (s,'f':'i':'g':':':tit)]) = do
blockToHtml opts (Para lst) = do
contents <- inlineListToHtml opts lst
return $ H.p contents
+blockToHtml opts (LineBlock lns) =
+ if writerWrapText opts == WrapNone
+ then blockToHtml opts $ linesToPara lns
+ else do
+ let lf = preEscapedString "\n"
+ htmlLines <- mconcat . intersperse lf <$> mapM (inlineListToHtml opts) lns
+ return $ H.div ! A.style "white-space: pre-line;" $ htmlLines
blockToHtml opts (Div attr@(ident, classes, kvs) bs) = do
let speakerNotes = "notes" `elem` classes
-- we don't want incremental output inside speaker notes, see #1394
@@ -807,7 +814,7 @@ inlineToHtml opts inline =
let brtag = if writerHtml5 opts then H5.br else H.br
return $ case t of
InlineMath -> m
- DisplayMath -> brtag >> m >> brtag
+ DisplayMath -> brtag >> m >> brtag
(RawInline f str)
| f == Format "html" -> return $ preEscapedString str
| otherwise -> return mempty
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 2e5f2dd08..caf549916 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -108,6 +108,8 @@ blockToHaddock opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) =
blockToHaddock opts (Para inlines) =
-- TODO: if it contains linebreaks, we need to use a @...@ block
(<> blankline) `fmap` blockToHaddock opts (Plain inlines)
+blockToHaddock opts (LineBlock lns) =
+ blockToHaddock opts $ linesToPara lns
blockToHaddock _ (RawBlock f str)
| f == "haddock" = do
return $ text str <> text "\n"
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index 57a61178e..8f6123e20 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -2,7 +2,7 @@
{- |
Module : Text.Pandoc.Writers.ICML
- Copyright : Copyright (C) 2013 github.com/mb21
+ Copyright : Copyright (C) 2013-2016 github.com/mb21
License : GNU GPL, version 2 or above
Stability : alpha
@@ -18,7 +18,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.XML
import Text.Pandoc.Readers.TeXMath (texMathToInlines)
import Text.Pandoc.Writers.Shared
-import Text.Pandoc.Shared (splitBy, fetchItem, warn)
+import Text.Pandoc.Shared (linesToPara, splitBy, fetchItem, warn)
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Pretty
@@ -297,6 +297,8 @@ blockToICML opts style (Para img@[Image _ txt (_,'f':'i':'g':':':_)]) = do
caption <- parStyle opts (imgCaptionName:style) txt
return $ intersperseBrs [figure, caption]
blockToICML opts style (Para lst) = parStyle opts (paragraphName:style) lst
+blockToICML opts style (LineBlock lns) =
+ blockToICML opts style $ linesToPara lns
blockToICML opts style (CodeBlock _ str) = parStyle opts (codeBlockName:style) $ [Str str]
blockToICML _ _ (RawBlock f str)
| f == Format "icml" = return $ text str
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index a88ff303f..0fd8cdd8c 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -87,7 +87,8 @@ writeLaTeX options document =
stOptions = options, stVerbInNote = False,
stTable = False, stStrikeout = False,
stUrl = False, stGraphics = False,
- stLHS = False, stBook = writerChapters options,
+ stLHS = False,
+ stBook = writerTopLevelDivision options < Section,
stCsquotes = False, stHighlighting = False,
stIncremental = writerIncremental options,
stInternalLinks = [], stUsesEuro = False }
@@ -437,6 +438,8 @@ blockToLaTeX (Para [Str ".",Space,Str ".",Space,Str "."]) = do
else inlineListToLaTeX [Str ".",Space,Str ".",Space,Str "."]
blockToLaTeX (Para lst) =
inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst
+blockToLaTeX (LineBlock lns) = do
+ blockToLaTeX $ linesToPara lns
blockToLaTeX (BlockQuote lst) = do
beamer <- writerBeamer `fmap` gets stOptions
case lst of
@@ -748,10 +751,18 @@ sectionHeader unnumbered ident level lst = do
<> braces (text plain))
book <- gets stBook
opts <- gets stOptions
- let level' = if book || writerChapters opts then level - 1 else level
+ let topLevelDivision = min (if book then Chapter else Section)
+ (writerTopLevelDivision opts)
+ let level' = if writerBeamer opts && topLevelDivision < Section
+ -- beamer has parts but no chapters
+ then if level == 1 then -1 else level - 1
+ else case topLevelDivision of
+ Part -> level - 2
+ Chapter -> level - 1
+ Section -> level
let sectionType = case level' of
- 0 | writerBeamer opts -> "part"
- | otherwise -> "chapter"
+ -1 -> "part"
+ 0 -> "chapter"
1 -> "section"
2 -> "subsection"
3 -> "subsubsection"
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index caf26d515..159e89308 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -171,6 +171,8 @@ blockToMan opts (Para inlines) = do
contents <- liftM vcat $ mapM (inlineListToMan opts) $
splitSentences inlines
return $ text ".PP" $$ contents
+blockToMan opts (LineBlock lns) =
+ blockToMan opts $ linesToPara lns
blockToMan _ (RawBlock f str)
| f == Format "man" = return $ text str
| otherwise = return empty
@@ -367,4 +369,3 @@ inlineToMan _ (Note contents) = do
notes <- liftM stNotes get
let ref = show $ (length notes)
return $ char '[' <> text ref <> char ']'
-
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index b04e33085..471b28d39 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables, MultiWayIf #-}
{-
Copyright (C) 2006-2015 John MacFarlane <jgm@berkeley.edu>
@@ -44,6 +44,7 @@ import Data.List ( group, stripPrefix, find, intersperse, transpose, sortBy )
import Data.Char ( isSpace, isPunctuation, ord, chr )
import Data.Ord ( comparing )
import Text.Pandoc.Pretty
+import Control.Monad.Reader
import Control.Monad.State
import Text.Pandoc.Writers.HTML (writeHtmlString)
import Text.Pandoc.Readers.TeXMath (texMathToInlines)
@@ -60,30 +61,52 @@ import Network.HTTP ( urlEncode )
type Notes = [[Block]]
type Ref = ([Inline], Target, Attr)
type Refs = [Ref]
-data WriterState = WriterState { stNotes :: Notes
- , stRefs :: Refs
- , stRefShortcutable :: Bool
- , stInList :: Bool
- , stIds :: Set.Set String
- , stPlain :: Bool }
+
+type MD = ReaderT WriterEnv (State WriterState)
+
+evalMD :: MD a -> WriterEnv -> WriterState -> a
+evalMD md env st = evalState (runReaderT md env) st
+
+data WriterEnv = WriterEnv { envInList :: Bool
+ , envPlain :: Bool
+ , envRefShortcutable :: Bool
+ , envBlockLevel :: Int
+ }
+
+instance Default WriterEnv
+ where def = WriterEnv { envInList = False
+ , envPlain = False
+ , envRefShortcutable = True
+ , envBlockLevel = 0
+ }
+
+data WriterState = WriterState { stNotes :: Notes
+ , stRefs :: Refs
+ , stIds :: Set.Set String
+ , stNoteNum :: Int
+ }
+
instance Default WriterState
- where def = WriterState{ stNotes = [], stRefs = [], stRefShortcutable = True,
- stInList = False, stIds = Set.empty, stPlain = False }
+ where def = WriterState{ stNotes = []
+ , stRefs = []
+ , stIds = Set.empty
+ , stNoteNum = 1
+ }
-- | Convert Pandoc to Markdown.
writeMarkdown :: WriterOptions -> Pandoc -> String
writeMarkdown opts document =
- evalState (pandocToMarkdown opts{
- writerWrapText = if isEnabled Ext_hard_line_breaks opts
- then WrapNone
- else writerWrapText opts }
- document) def
+ evalMD (pandocToMarkdown opts{
+ writerWrapText = if isEnabled Ext_hard_line_breaks opts
+ then WrapNone
+ else writerWrapText opts }
+ document) def def
-- | Convert Pandoc to plain text (like markdown, but without links,
-- pictures, or inline formatting).
writePlain :: WriterOptions -> Pandoc -> String
writePlain opts document =
- evalState (pandocToMarkdown opts document) def{ stPlain = True }
+ evalMD (pandocToMarkdown opts document) def{ envPlain = True } def
pandocTitleBlock :: Doc -> [Doc] -> Doc -> Doc
pandocTitleBlock tit auths dat =
@@ -146,12 +169,12 @@ jsonToYaml (Number n) = text $ show n
jsonToYaml _ = empty
-- | Return markdown representation of document.
-pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
+pandocToMarkdown :: WriterOptions -> Pandoc -> MD String
pandocToMarkdown opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- isPlain <- gets stPlain
+ isPlain <- asks envPlain
metadata <- metaToJSON opts
(fmap (render colwidth) . blockListToMarkdown opts)
(fmap (render colwidth) . inlineListToMarkdown opts)
@@ -181,15 +204,10 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
_ -> blocks
else blocks
body <- blockListToMarkdown opts blocks'
- st <- get
- notes' <- notesToMarkdown opts (reverse $ stNotes st)
- st' <- get -- note that the notes may contain refs
- refs' <- refsToMarkdown opts (reverse $ stRefs st')
+ notesAndRefs' <- notesAndRefs opts
let render' :: Doc -> String
render' = render colwidth
- let main = render' $ body <>
- (if isEmpty notes' then empty else blankline <> notes') <>
- (if isEmpty refs' then empty else blankline <> refs')
+ let main = render' $ body <> notesAndRefs'
let context = defField "toc" (render' toc)
$ defField "body" main
$ (if isNullMeta meta
@@ -201,13 +219,13 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
else return main
-- | Return markdown representation of reference key table.
-refsToMarkdown :: WriterOptions -> Refs -> State WriterState Doc
+refsToMarkdown :: WriterOptions -> Refs -> MD Doc
refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
-- | Return markdown representation of a reference key.
keyToMarkdown :: WriterOptions
-> Ref
- -> State WriterState Doc
+ -> MD Doc
keyToMarkdown opts (label, (src, tit), attr) = do
label' <- inlineListToMarkdown opts label
let tit' = if null tit
@@ -218,13 +236,15 @@ keyToMarkdown opts (label, (src, tit), attr) = do
<> linkAttributes opts attr
-- | Return markdown representation of notes.
-notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc
-notesToMarkdown opts notes =
- mapM (\(num, note) -> noteToMarkdown opts num note) (zip [1..] notes) >>=
- return . vsep
+notesToMarkdown :: WriterOptions -> [[Block]] -> MD Doc
+notesToMarkdown opts notes = do
+ n <- gets stNoteNum
+ notes' <- mapM (\(num, note) -> noteToMarkdown opts num note) (zip [n..] notes)
+ modify $ \st -> st { stNoteNum = stNoteNum st + length notes }
+ return $ vsep notes'
-- | Return markdown representation of a note.
-noteToMarkdown :: WriterOptions -> Int -> [Block] -> State WriterState Doc
+noteToMarkdown :: WriterOptions -> Int -> [Block] -> MD Doc
noteToMarkdown opts num blocks = do
contents <- blockListToMarkdown opts blocks
let num' = text $ writerIdentifierPrefix opts ++ show num
@@ -261,7 +281,7 @@ tableOfContents :: WriterOptions -> [Block] -> Doc
tableOfContents opts headers =
let opts' = opts { writerIgnoreNotes = True }
contents = BulletList $ map (elementToListItem opts) $ hierarchicalize headers
- in evalState (blockToMarkdown opts' contents) def
+ in evalMD (blockToMarkdown opts' contents) def def
-- | Converts an Element to a list item for a table of contents,
elementToListItem :: WriterOptions -> Element -> [Block]
@@ -312,22 +332,50 @@ beginsWithOrderedListMarker str =
Left _ -> False
Right _ -> True
+notesAndRefs :: WriterOptions -> MD Doc
+notesAndRefs opts = do
+ notes' <- reverse <$> gets stNotes >>= notesToMarkdown opts
+ modify $ \s -> s { stNotes = [] }
+ refs' <- reverse <$> gets stRefs >>= refsToMarkdown opts
+ modify $ \s -> s { stRefs = [] }
+
+ let endSpacing =
+ if | writerReferenceLocation opts == EndOfDocument -> empty
+ | isEmpty notes' && isEmpty refs' -> empty
+ | otherwise -> blankline
+
+ return $
+ (if isEmpty notes' then empty else blankline <> notes') <>
+ (if isEmpty refs' then empty else blankline <> refs') <>
+ endSpacing
+
-- | Convert Pandoc block element to markdown.
blockToMarkdown :: WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> State WriterState Doc
-blockToMarkdown _ Null = return empty
-blockToMarkdown opts (Div attrs ils) = do
+ -> MD Doc
+blockToMarkdown opts blk =
+ local (\env -> env {envBlockLevel = envBlockLevel env + 1}) $
+ do doc <- blockToMarkdown' opts blk
+ blkLevel <- asks envBlockLevel
+ if writerReferenceLocation opts == EndOfBlock && blkLevel == 1
+ then notesAndRefs opts >>= (\d -> return $ doc <> d)
+ else return doc
+
+blockToMarkdown' :: WriterOptions -- ^ Options
+ -> Block -- ^ Block element
+ -> MD Doc
+blockToMarkdown' _ Null = return empty
+blockToMarkdown' opts (Div attrs ils) = do
contents <- blockListToMarkdown opts ils
return $ if isEnabled Ext_raw_html opts &&
isEnabled Ext_markdown_in_html_blocks opts
then tagWithAttrs "div" attrs <> blankline <>
contents <> blankline <> "</div>" <> blankline
else contents <> blankline
-blockToMarkdown opts (Plain inlines) = do
+blockToMarkdown' opts (Plain inlines) = do
contents <- inlineListToMarkdown opts inlines
-- escape if para starts with ordered list marker
- st <- get
+ isPlain <- asks envPlain
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
@@ -336,33 +384,47 @@ blockToMarkdown opts (Plain inlines) = do
| otherwise = x : escapeDelimiter xs
escapeDelimiter [] = []
let contents' = if isEnabled Ext_all_symbols_escapable opts &&
- not (stPlain st) && beginsWithOrderedListMarker rendered
+ not isPlain && beginsWithOrderedListMarker rendered
then text $ escapeDelimiter rendered
else contents
return $ contents' <> cr
-- title beginning with fig: indicates figure
-blockToMarkdown opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) =
+blockToMarkdown' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) =
blockToMarkdown opts (Para [Image attr alt (src,tit)])
-blockToMarkdown opts (Para inlines) =
+blockToMarkdown' opts (Para inlines) =
(<> blankline) `fmap` blockToMarkdown opts (Plain inlines)
-blockToMarkdown opts (RawBlock f str)
- | f == "html" = do
- plain <- gets stPlain
+blockToMarkdown' opts (LineBlock lns) =
+ if isEnabled Ext_line_blocks opts
+ then do
+ mdLines <- mapM (inlineListToMarkdown opts) lns
+ return $ (vcat $ map (hang 2 (text "| ")) mdLines) <> blankline
+ else blockToMarkdown opts $ linesToPara lns
+blockToMarkdown' opts (RawBlock f str)
+ | f == "markdown" = return $ text str <> text "\n"
+ | f == "html" && isEnabled Ext_raw_html opts = do
+ plain <- asks envPlain
return $ if plain
then empty
else if isEnabled Ext_markdown_attribute opts
then text (addMarkdownAttribute str) <> text "\n"
else text str <> text "\n"
- | f `elem` ["latex", "tex", "markdown"] = do
- plain <- gets stPlain
+ | f `elem` ["latex", "tex"] && isEnabled Ext_raw_tex opts = do
+ plain <- asks envPlain
return $ if plain
then empty
else text str <> text "\n"
-blockToMarkdown _ (RawBlock _ _) = return empty
-blockToMarkdown opts HorizontalRule = do
+ | otherwise = return empty
+blockToMarkdown' opts HorizontalRule = do
return $ blankline <> text (replicate (writerColumns opts) '-') <> blankline
-blockToMarkdown opts (Header level attr inlines) = do
- plain <- gets stPlain
+blockToMarkdown' opts (Header level attr inlines) = do
+ -- first, if we're putting references at the end of a section, we
+ -- put them here.
+ blkLevel <- asks envBlockLevel
+ refs <- if writerReferenceLocation opts == EndOfSection && blkLevel == 1
+ then notesAndRefs opts
+ else return empty
+
+ plain <- asks envPlain
-- we calculate the id that would be used by auto_identifiers
-- so we know whether to print an explicit identifier
ids <- gets stIds
@@ -382,8 +444,7 @@ blockToMarkdown opts (Header level attr inlines) = do
then capitalize inlines
else inlines
let setext = writerSetextHeaders opts
- return $ nowrap
- $ case level of
+ hdr = nowrap $ case level of
1 | plain -> blanklines 3 <> contents <> blanklines 2
| setext ->
contents <> attr' <> cr <> text (replicate (offset contents) '=') <>
@@ -396,11 +457,13 @@ blockToMarkdown opts (Header level attr inlines) = do
_ | plain || isEnabled Ext_literate_haskell opts ->
contents <> blankline
_ -> text (replicate level '#') <> space <> contents <> attr' <> blankline
-blockToMarkdown opts (CodeBlock (_,classes,_) str)
+
+ return $ refs <> hdr
+blockToMarkdown' opts (CodeBlock (_,classes,_) str)
| "haskell" `elem` classes && "literate" `elem` classes &&
isEnabled Ext_literate_haskell opts =
return $ prefixed "> " (text str) <> blankline
-blockToMarkdown opts (CodeBlock attribs str) = return $
+blockToMarkdown' opts (CodeBlock attribs str) = return $
case attribs == nullAttr of
False | isEnabled Ext_backtick_code_blocks opts ->
backticks <> attrs <> cr <> text str <> cr <> backticks <> blankline
@@ -422,8 +485,8 @@ blockToMarkdown opts (CodeBlock attribs str) = return $
else case attribs of
(_,(cls:_),_) -> " " <> text cls
_ -> empty
-blockToMarkdown opts (BlockQuote blocks) = do
- plain <- gets stPlain
+blockToMarkdown' opts (BlockQuote blocks) = do
+ plain <- asks envPlain
-- if we're writing literate haskell, put a space before the bird tracks
-- so they won't be interpreted as lhs...
let leader = if isEnabled Ext_literate_haskell opts
@@ -431,7 +494,7 @@ blockToMarkdown opts (BlockQuote blocks) = do
else if plain then " " else "> "
contents <- blockListToMarkdown opts blocks
return $ (prefixed leader contents) <> blankline
-blockToMarkdown opts t@(Table caption aligns widths headers rows) = do
+blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do
caption' <- inlineListToMarkdown opts caption
let caption'' = if null caption || not (isEnabled Ext_table_captions opts)
then empty
@@ -460,14 +523,15 @@ blockToMarkdown opts t@(Table caption aligns widths headers rows) = do
| isEnabled Ext_grid_tables opts -> fmap (id,) $
gridTable opts (all null headers) aligns widths
rawHeaders rawRows
- | otherwise -> fmap (id,) $
+ | isEnabled Ext_raw_html opts -> fmap (id,) $
return $ text $ writeHtmlString def
$ Pandoc nullMeta [t]
+ | otherwise -> return $ (id, text "[TABLE]")
return $ nst $ tbl $$ blankline $$ caption'' $$ blankline
-blockToMarkdown opts (BulletList items) = do
+blockToMarkdown' opts (BulletList items) = do
contents <- inList $ mapM (bulletListItemToMarkdown opts) items
return $ cat contents <> blankline
-blockToMarkdown opts (OrderedList (start,sty,delim) items) = do
+blockToMarkdown' opts (OrderedList (start,sty,delim) items) = do
let start' = if isEnabled Ext_startnum opts then start else 1
let sty' = if isEnabled Ext_fancy_lists opts then sty else DefaultStyle
let delim' = if isEnabled Ext_fancy_lists opts then delim else DefaultDelim
@@ -480,17 +544,12 @@ blockToMarkdown opts (OrderedList (start,sty,delim) items) = do
mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $
zip markers' items
return $ cat contents <> blankline
-blockToMarkdown opts (DefinitionList items) = do
+blockToMarkdown' opts (DefinitionList items) = do
contents <- inList $ mapM (definitionListItemToMarkdown opts) items
return $ cat contents <> blankline
-inList :: State WriterState a -> State WriterState a
-inList p = do
- oldInList <- gets stInList
- modify $ \st -> st{ stInList = True }
- res <- p
- modify $ \st -> st{ stInList = oldInList }
- return res
+inList :: MD a -> MD a
+inList p = local (\env -> env {envInList = True}) p
addMarkdownAttribute :: String -> String
addMarkdownAttribute s =
@@ -501,7 +560,7 @@ addMarkdownAttribute s =
x /= "markdown"]
_ -> s
-pipeTable :: Bool -> [Alignment] -> [Doc] -> [[Doc]] -> State WriterState Doc
+pipeTable :: Bool -> [Alignment] -> [Doc] -> [[Doc]] -> MD Doc
pipeTable headless aligns rawHeaders rawRows = do
let sp = text " "
let blockFor AlignLeft x y = lblock (x + 2) (sp <> y) <> lblock 0 empty
@@ -530,7 +589,7 @@ pipeTable headless aligns rawHeaders rawRows = do
return $ header $$ border $$ body
pandocTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
- -> [Doc] -> [[Doc]] -> State WriterState Doc
+ -> [Doc] -> [[Doc]] -> MD Doc
pandocTable opts headless aligns widths rawHeaders rawRows = do
let isSimple = all (==0) widths
let alignHeader alignment = case alignment of
@@ -570,7 +629,7 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do
return $ head'' $$ underline $$ body $$ bottom
gridTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
- -> [Doc] -> [[Doc]] -> State WriterState Doc
+ -> [Doc] -> [[Doc]] -> MD Doc
gridTable opts headless _aligns widths headers' rawRows = do
let numcols = length headers'
let widths' = if all (==0) widths
@@ -597,7 +656,7 @@ gridTable opts headless _aligns widths headers' rawRows = do
return $ border '-' $$ head'' $$ body $$ border '-'
-- | Convert bullet list item (list of blocks) to markdown.
-bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc
+bulletListItemToMarkdown :: WriterOptions -> [Block] -> MD Doc
bulletListItemToMarkdown opts items = do
contents <- blockListToMarkdown opts items
let sps = replicate (writerTabStop opts - 2) ' '
@@ -615,7 +674,7 @@ bulletListItemToMarkdown opts items = do
orderedListItemToMarkdown :: WriterOptions -- ^ options
-> String -- ^ list item marker
-> [Block] -- ^ list item (list of blocks)
- -> State WriterState Doc
+ -> MD Doc
orderedListItemToMarkdown opts marker items = do
contents <- blockListToMarkdown opts items
let sps = case length marker - writerTabStop opts of
@@ -627,15 +686,15 @@ orderedListItemToMarkdown opts marker items = do
-- | Convert definition list item (label, list of blocks) to markdown.
definitionListItemToMarkdown :: WriterOptions
-> ([Inline],[[Block]])
- -> State WriterState Doc
+ -> MD Doc
definitionListItemToMarkdown opts (label, defs) = do
labelText <- inlineListToMarkdown opts label
defs' <- mapM (mapM (blockToMarkdown opts)) defs
if isEnabled Ext_definition_lists opts
then do
let tabStop = writerTabStop opts
- st <- get
- let leader = if stPlain st then " " else ": "
+ isPlain <- asks envPlain
+ let leader = if isPlain then " " else ": "
let sps = case writerTabStop opts - 3 of
n | n > 0 -> text $ replicate n ' '
_ -> text " "
@@ -659,7 +718,7 @@ definitionListItemToMarkdown opts (label, defs) = do
-- | Convert list of Pandoc block elements to markdown.
blockListToMarkdown :: WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
- -> State WriterState Doc
+ -> MD Doc
blockListToMarkdown opts blocks =
mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat
-- insert comment between list and indented code block, or the
@@ -680,11 +739,13 @@ blockListToMarkdown opts blocks =
isListBlock (OrderedList _ _) = True
isListBlock (DefinitionList _) = True
isListBlock _ = False
- commentSep = RawBlock "html" "<!-- -->\n"
+ commentSep = if isEnabled Ext_raw_html opts
+ then RawBlock "html" "<!-- -->\n"
+ else RawBlock "markdown" "&nbsp;"
-- | Get reference for target; if none exists, create unique one and return.
-- Prefer label if possible; otherwise, generate a unique key.
-getReference :: Attr -> [Inline] -> Target -> State WriterState [Inline]
+getReference :: Attr -> [Inline] -> Target -> MD [Inline]
getReference attr label target = do
st <- get
case find (\(_,t,a) -> t == target && a == attr) (stRefs st) of
@@ -702,9 +763,9 @@ getReference attr label target = do
return label'
-- | Convert list of Pandoc inline elements to markdown.
-inlineListToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
+inlineListToMarkdown :: WriterOptions -> [Inline] -> MD Doc
inlineListToMarkdown opts lst = do
- inlist <- gets stInList
+ inlist <- asks envInList
go (if inlist then avoidBadWrapsInList lst else lst)
where go [] = return empty
go (i:is) = case i of
@@ -727,9 +788,9 @@ inlineListToMarkdown opts lst = do
_ -> shortcutable
where shortcutable = liftM2 (<>) (inlineToMarkdown opts i) (go is)
unshortcutable = do
- iMark <- withState (\s -> s { stRefShortcutable = False })
- (inlineToMarkdown opts i)
- modify (\s -> s {stRefShortcutable = True })
+ iMark <- local
+ (\env -> env { envRefShortcutable = False })
+ (inlineToMarkdown opts i)
fmap (iMark <>) (go is)
isSp :: Inline -> Bool
@@ -769,22 +830,22 @@ escapeSpaces SoftBreak = Str "\\ "
escapeSpaces x = x
-- | Convert Pandoc inline element to markdown.
-inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc
+inlineToMarkdown :: WriterOptions -> Inline -> MD Doc
inlineToMarkdown opts (Span attrs ils) = do
- plain <- gets stPlain
+ plain <- asks envPlain
contents <- inlineListToMarkdown opts ils
return $ if not plain &&
(isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
then tagWithAttrs "span" attrs <> contents <> text "</span>"
else contents
inlineToMarkdown opts (Emph lst) = do
- plain <- gets stPlain
+ plain <- asks envPlain
contents <- inlineListToMarkdown opts lst
return $ if plain
then "_" <> contents <> "_"
else "*" <> contents <> "*"
inlineToMarkdown opts (Strong lst) = do
- plain <- gets stPlain
+ plain <- asks envPlain
if plain
then inlineListToMarkdown opts $ capitalize lst
else do
@@ -823,7 +884,7 @@ inlineToMarkdown opts (Subscript lst) = do
_ -> contents
where toSubscript c = chr (0x2080 + (ord c - 48))
inlineToMarkdown opts (SmallCaps lst) = do
- plain <- gets stPlain
+ plain <- asks envPlain
if not plain &&
(isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
then do
@@ -848,13 +909,13 @@ inlineToMarkdown opts (Code attr str) = do
let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr
then attrsToMarkdown attr
else empty
- plain <- gets stPlain
+ plain <- asks envPlain
if plain
then return $ text str
else return $ text (marker ++ spacer ++ str ++ spacer ++ marker) <> attrs
inlineToMarkdown opts (Str str) = do
- st <- get
- if stPlain st
+ isPlain <- asks envPlain
+ if isPlain
then return $ text str
else return $ text $ escapeString opts str
inlineToMarkdown opts (Math InlineMath str) =
@@ -869,7 +930,7 @@ inlineToMarkdown opts (Math InlineMath str) =
| isEnabled Ext_tex_math_double_backslash opts ->
return $ "\\\\(" <> text str <> "\\\\)"
| otherwise -> do
- plain <- gets stPlain
+ plain <- asks envPlain
inlineListToMarkdown opts $
(if plain then makeMathPlainer else id) $
texMathToInlines InlineMath str
@@ -883,7 +944,7 @@ inlineToMarkdown opts (Math DisplayMath str)
| otherwise = (\x -> cr <> x <> cr) `fmap`
inlineListToMarkdown opts (texMathToInlines DisplayMath str)
inlineToMarkdown opts (RawInline f str) = do
- plain <- gets stPlain
+ plain <- asks envPlain
if not plain &&
( f == "markdown" ||
(isEnabled Ext_raw_tex opts && (f == "latex" || f == "tex")) ||
@@ -891,7 +952,7 @@ inlineToMarkdown opts (RawInline f str) = do
then return $ text str
else return empty
inlineToMarkdown opts (LineBreak) = do
- plain <- gets stPlain
+ plain <- asks envPlain
if plain || isEnabled Ext_hard_line_breaks opts
then return cr
else return $
@@ -940,7 +1001,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
attr /= nullAttr = -- use raw HTML
return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]]
| otherwise = do
- plain <- gets stPlain
+ plain <- asks envPlain
linktext <- inlineListToMarkdown opts txt
let linktitle = if null tit
then empty
@@ -951,7 +1012,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
[Str s] | escapeURI s == srcSuffix -> True
_ -> False
let useRefLinks = writerReferenceLinks opts && not useAuto
- shortcutable <- gets stRefShortcutable
+ shortcutable <- asks envRefShortcutable
let useShortcutRefLinks = shortcutable &&
isEnabled Ext_shortcut_reference_links opts
ref <- if useRefLinks then getReference attr txt (src, tit) else return []
@@ -979,7 +1040,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
attr /= nullAttr = -- use raw HTML
return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [img]]
| otherwise = do
- plain <- gets stPlain
+ plain <- asks envPlain
let txt = if null alternate || alternate == [Str source]
-- to prevent autolinks
then [Str ""]
@@ -991,7 +1052,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
inlineToMarkdown opts (Note contents) = do
modify (\st -> st{ stNotes = contents : stNotes st })
st <- get
- let ref = text $ writerIdentifierPrefix opts ++ show (length $ stNotes st)
+ let ref = text $ writerIdentifierPrefix opts ++ show (stNoteNum st + (length $ stNotes st) - 1)
if isEnabled Ext_footnotes opts
then return $ "[^" <> ref <> "]"
else return $ "[" <> ref <> "]"
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index 0da8bc98c..3b2028997 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -120,6 +120,9 @@ blockToMediaWiki (Para inlines) = do
then "<p>" ++ contents ++ "</p>"
else contents ++ if null lev then "\n" else ""
+blockToMediaWiki (LineBlock lns) =
+ blockToMediaWiki $ linesToPara lns
+
blockToMediaWiki (RawBlock f str)
| f == Format "mediawiki" = return str
| f == Format "html" = return str
diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index fc96e3e3c..2a9bc5138 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -45,6 +45,8 @@ prettyList ds =
-- | Prettyprint Pandoc block element.
prettyBlock :: Block -> Doc
+prettyBlock (LineBlock lines') =
+ "LineBlock" $$ prettyList (map (text . show) lines')
prettyBlock (BlockQuote blocks) =
"BlockQuote" $$ prettyList (map prettyBlock blocks)
prettyBlock (OrderedList attribs blockLists) =
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index e0434c630..583aa2e4a 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -33,6 +33,7 @@ module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.XML
+import Text.Pandoc.Shared (linesToPara)
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Pretty
@@ -291,6 +292,7 @@ blockToOpenDocument o bs
| Para b <- bs = if null b
then return empty
else inParagraphTags =<< inlinesToOpenDocument o b
+ | LineBlock b <- bs = blockToOpenDocument o $ linesToPara b
| Div _ xs <- bs = blocksToOpenDocument o xs
| Header i _ b <- bs = setFirstPara >>
(inHeaderTags i =<< inlinesToOpenDocument o b)
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 96baacbb6..18a820f2e 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -164,6 +164,17 @@ blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
blockToOrg (Para inlines) = do
contents <- inlineListToOrg inlines
return $ contents <> blankline
+blockToOrg (LineBlock lns) = do
+ let splitStanza [] = []
+ splitStanza xs = case break (== mempty) xs of
+ (l, []) -> l : []
+ (l, _:r) -> l : splitStanza r
+ let joinWithLinefeeds = nowrap . mconcat . intersperse cr
+ let joinWithBlankLines = mconcat . intersperse blankline
+ let prettyfyStanza ls = joinWithLinefeeds <$> mapM inlineListToOrg ls
+ contents <- joinWithBlankLines <$> mapM prettyfyStanza (splitStanza lns)
+ return $ blankline $$ "#+BEGIN_VERSE" $$
+ nest 2 contents $$ "#+END_VERSE" <> blankline
blockToOrg (RawBlock "html" str) =
return $ blankline $$ "#+BEGIN_HTML" $$
nest 2 (text str) $$ "#+END_HTML" $$ blankline
@@ -362,7 +373,7 @@ inlineToOrg (Note contents) = do
notes <- get >>= (return . stNotes)
modify $ \st -> st { stNotes = contents:notes }
let ref = show $ (length notes) + 1
- return $ " [" <> text ref <> "]"
+ return $ "[" <> text ref <> "]"
orgPath :: String -> String
orgPath src =
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 98c39bdaf..21f1acd6e 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -201,11 +201,12 @@ blockToRST (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
return $ hang 3 ".. " (fig $$ alt $$ classes $$ dims $+$ capt) $$ blankline
blockToRST (Para inlines)
| LineBreak `elem` inlines = do -- use line block if LineBreaks
- lns <- mapM inlineListToRST $ splitBy (==LineBreak) inlines
- return $ (vcat $ map (hang 2 (text "| ")) lns) <> blankline
+ linesToLineBlock $ splitBy (==LineBreak) inlines
| otherwise = do
contents <- inlineListToRST inlines
return $ contents <> blankline
+blockToRST (LineBlock lns) =
+ linesToLineBlock lns
blockToRST (RawBlock f@(Format f') str)
| f == "rst" = return $ text str
| otherwise = return $ blankline <> ".. raw:: " <>
@@ -328,6 +329,12 @@ definitionListItemToRST (label, defs) = do
tabstop <- get >>= (return . writerTabStop . stOptions)
return $ label' $$ nest tabstop (nestle contents <> cr)
+-- | Format a list of lines as line block.
+linesToLineBlock :: [[Inline]] -> State WriterState Doc
+linesToLineBlock inlineLines = do
+ lns <- mapM inlineListToRST inlineLines
+ return $ (vcat $ map (hang 2 (text "| ")) lns) <> blankline
+
-- | Convert list of Pandoc block elements to RST.
blockListToRST' :: Bool
-> [Block] -- ^ List of block elements
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index 79a28c880..b87ef0fd3 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -233,6 +233,8 @@ blockToRTF indent alignment (Plain lst) =
rtfCompact indent 0 alignment $ inlineListToRTF lst
blockToRTF indent alignment (Para lst) =
rtfPar indent 0 alignment $ inlineListToRTF lst
+blockToRTF indent alignment (LineBlock lns) =
+ blockToRTF indent alignment $ linesToPara lns
blockToRTF indent alignment (BlockQuote lst) =
concatMap (blockToRTF (indent + indentIncrement) alignment) lst
blockToRTF indent _ (CodeBlock _ str) =
diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs
index b9e683ab9..6120330ca 100644
--- a/src/Text/Pandoc/Writers/TEI.hs
+++ b/src/Text/Pandoc/Writers/TEI.hs
@@ -35,7 +35,7 @@ import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate')
-import Data.List ( stripPrefix, isPrefixOf, isSuffixOf )
+import Data.List ( stripPrefix, isPrefixOf )
import Data.Char ( toLower )
import Text.Pandoc.Highlighting ( languages, languagesByExtension )
import Text.Pandoc.Pretty
@@ -60,19 +60,18 @@ writeTEI opts (Pandoc meta blocks) =
then Just $ writerColumns opts
else Nothing
render' = render colwidth
- opts' = if "/book>" `isSuffixOf`
- (trimr $ writerTemplate opts)
- then opts{ writerChapters = True }
- else opts
- startLvl = if writerChapters opts' then 0 else 1
+ startLvl = case writerTopLevelDivision opts of
+ Part -> -1
+ Chapter -> 0
+ Section -> 1
auths' = map (authorToTEI opts) $ docAuthors meta
meta' = B.setMeta "author" auths' meta
Just metadata = metaToJSON opts
(Just . render colwidth . (vcat .
- (map (elementToTEI opts' startLvl)) . hierarchicalize))
- (Just . render colwidth . inlinesToTEI opts')
+ (map (elementToTEI opts startLvl)) . hierarchicalize))
+ (Just . render colwidth . inlinesToTEI opts)
meta'
- main = render' $ vcat (map (elementToTEI opts' startLvl) elements)
+ main = render' $ vcat (map (elementToTEI opts startLvl) elements)
context = defField "body" main
$ defField "mathml" (case writerHTMLMathMethod opts of
MathML _ -> True
@@ -90,8 +89,10 @@ elementToTEI opts lvl (Sec _ _num (id',_,_) title elements) =
let elements' = if null elements
then [Blk (Para [])]
else elements
+ -- level numbering correspond to LaTeX internals
divType = case lvl of
- n | n == 0 -> "chapter"
+ n | n == -1 -> "part"
+ | n == 0 -> "chapter"
| n >= 1 && n <= 5 -> "level" ++ show n
| otherwise -> "section"
in inTags True "div" [("type", divType) | not (null id')] $
@@ -108,7 +109,7 @@ plainToPara :: Block -> Block
plainToPara (Plain x) = Para x
plainToPara x = x
--- | Convert a list of pairs of terms and definitions into a TEI
+-- | Convert a list of pairs of terms and definitions into a TEI
-- list with labels and items.
deflistItemsToTEI :: WriterOptions -> [([Inline],[[Block]])] -> Doc
deflistItemsToTEI opts items =
@@ -167,6 +168,8 @@ blockToTEI opts (Plain lst) = blockToTEI opts $ Para lst
-- inTagsSimple "textobject" (inTagsSimple "phrase" alt))
blockToTEI opts (Para lst) =
inTags False "p" [] $ inlinesToTEI opts lst
+blockToTEI opts (LineBlock lns) =
+ blockToTEI opts $ linesToPara lns
blockToTEI opts (BlockQuote blocks) =
inTagsIndented "quote" $ blocksToTEI opts blocks
blockToTEI _ (CodeBlock (_,classes,_) str) =
@@ -174,7 +177,7 @@ blockToTEI _ (CodeBlock (_,classes,_) str) =
flush (text (escapeStringForXML str) <> cr <> text "</ab>")
where lang = if null langs
then ""
- else escapeStringForXML (head langs)
+ else escapeStringForXML (head langs)
isLang l = map toLower l `elem` map (map toLower) languages
langsFrom s = if isLang s
then [s]
@@ -210,7 +213,7 @@ blockToTEI _ HorizontalRule =
selfClosingTag "milestone" [("unit","undefined"), ("type","separator"),("rendition","line")]
-- | TEI Tables
--- TEI Simple's tables are composed of cells and rows; other
+-- TEI Simple's tables are composed of cells and rows; other
-- table info in the AST is here lossily discard.
blockToTEI opts (Table _ _ _ headers rows) =
let
@@ -219,8 +222,8 @@ blockToTEI opts (Table _ _ _ headers rows) =
-- then return empty
-- else tableRowToTEI opts headers
in
- inTags True "table" [] $
- vcat $ [headers'] <> map (tableRowToTEI opts) rows
+ inTags True "table" [] $
+ vcat $ [headers'] <> map (tableRowToTEI opts) rows
tableRowToTEI :: WriterOptions
-> [[Block]]
@@ -276,7 +279,7 @@ inlineToTEI _ (Math t str) =
text (str)
DisplayMath -> inTags True "figure" [("type","math")] $
inTags False "formula" [("notation","TeX")] $ text (str)
-
+
inlineToTEI _ (RawInline f x) | f == "tei" = text x
| otherwise = empty
inlineToTEI _ LineBreak = selfClosingTag "lb" []
@@ -317,4 +320,3 @@ idAndRole (id',cls,_) = ident ++ role
role = if null cls
then []
else [("role", unwords cls)]
-
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index 8420704dc..b94229943 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -145,6 +145,9 @@ blockToTexinfo (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
blockToTexinfo (Para lst) =
inlineListToTexinfo lst -- this is handled differently from Plain in blockListToTexinfo
+blockToTexinfo (LineBlock lns) =
+ blockToTexinfo $ linesToPara lns
+
blockToTexinfo (BlockQuote lst) = do
contents <- blockListToTexinfo lst
return $ text "@quotation" $$
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
index 98f9157fb..ec70f3072 100644
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -130,6 +130,9 @@ blockToTextile opts (Para inlines) = do
then "<p>" ++ contents ++ "</p>"
else contents ++ if null listLevel then "\n" else ""
+blockToTextile opts (LineBlock lns) =
+ blockToTextile opts $ linesToPara lns
+
blockToTextile _ (RawBlock f str)
| f == Format "html" || f == Format "textile" = return str
| otherwise = return ""
diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs
index 05563970a..8afbfef92 100644
--- a/src/Text/Pandoc/Writers/ZimWiki.hs
+++ b/src/Text/Pandoc/Writers/ZimWiki.hs
@@ -33,7 +33,8 @@ http://zim-wiki.org/manual/Help/Wiki_Syntax.html
module Text.Pandoc.Writers.ZimWiki ( writeZimWiki ) where
import Text.Pandoc.Definition
import Text.Pandoc.Options ( WriterOptions(writerTableOfContents, writerStandalone, writerTemplate, writerWrapText), WrapOption(..) )
-import Text.Pandoc.Shared ( escapeURI, removeFormatting, trimr, substitute )
+import Text.Pandoc.Shared ( escapeURI, linesToPara, removeFormatting, trimr
+ , substitute )
import Text.Pandoc.Writers.Shared ( defField, metaToJSON )
import Text.Pandoc.ImageSize
import Text.Pandoc.Templates ( renderTemplate' )
@@ -111,6 +112,9 @@ blockToZimWiki opts (Para inlines) = do
contents <- inlineListToZimWiki opts inlines
return $ contents ++ if null indent then "\n" else ""
+blockToZimWiki opts (LineBlock lns) = do
+ blockToZimWiki opts $ linesToPara lns
+
blockToZimWiki opts (RawBlock f str)
| f == Format "zimwiki" = return str
| f == Format "html" = do cont <- indentFromHTML opts str; return cont