aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2019-08-14 22:11:05 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2019-08-25 14:24:31 -0700
commit1ee6e0e0878bcd655f31deb0caf6a4766e500cc6 (patch)
tree5f11cadde103d1cb72e9b1cbf6eeb2b61a570e9b /src
parent8959c44e6ae2a2f79ca55c2c173f84bf8d3abfc7 (diff)
downloadpandoc-1ee6e0e0878bcd655f31deb0caf6a4766e500cc6.tar.gz
Use new doctemplates, doclayout.
+ Remove Text.Pandoc.Pretty; use doclayout instead. [API change] + Text.Pandoc.Writers.Shared: remove metaToJSON, metaToJSON' [API change]. + Text.Pandoc.Writers.Shared: modify `addVariablesToContext`, `defField`, `setField`, `getField`, `resetField` to work with Context rather than JSON values. [API change] + Text.Pandoc.Writers.Shared: export new function `endsWithPlain` [API change]. + Use new templates and doclayout in writers. + Use Doc-based templates in all writers. + Adjust three tests for minor template rendering differences. + Added indentation to body in docbook4, docbook5 templates. The main impact of this change is better reflowing of content interpolated into templates. Previously, interpolated variables were rendered independently and intepolated as strings, which could lead to overly long lines. Now the templates interpolated as Doc values which may include breaking spaces, and reflowing occurs after template interpolation rather than before.
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Class.hs16
-rw-r--r--src/Text/Pandoc/PDF.hs16
-rw-r--r--src/Text/Pandoc/Pretty.hs543
-rw-r--r--src/Text/Pandoc/Shared.hs2
-rw-r--r--src/Text/Pandoc/Templates.hs7
-rw-r--r--src/Text/Pandoc/Writers/AsciiDoc.hs52
-rw-r--r--src/Text/Pandoc/Writers/CommonMark.hs6
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs83
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs8
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs48
-rw-r--r--src/Text/Pandoc/Writers/DokuWiki.hs12
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs39
-rw-r--r--src/Text/Pandoc/Writers/Haddock.hs66
-rw-r--r--src/Text/Pandoc/Writers/ICML.hs57
-rw-r--r--src/Text/Pandoc/Writers/Ipynb.hs11
-rw-r--r--src/Text/Pandoc/Writers/JATS.hs71
-rw-r--r--src/Text/Pandoc/Writers/Jira.hs4
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs121
-rw-r--r--src/Text/Pandoc/Writers/Man.hs38
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs228
-rw-r--r--src/Text/Pandoc/Writers/MediaWiki.hs10
-rw-r--r--src/Text/Pandoc/Writers/Ms.hs55
-rw-r--r--src/Text/Pandoc/Writers/Muse.hs56
-rw-r--r--src/Text/Pandoc/Writers/Native.hs8
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs2
-rw-r--r--src/Text/Pandoc/Writers/OPML.hs12
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs107
-rw-r--r--src/Text/Pandoc/Writers/Org.hs69
-rw-r--r--src/Text/Pandoc/Writers/RST.hs96
-rw-r--r--src/Text/Pandoc/Writers/RTF.hs7
-rw-r--r--src/Text/Pandoc/Writers/Roff.hs8
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs209
-rw-r--r--src/Text/Pandoc/Writers/TEI.hs43
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs49
-rw-r--r--src/Text/Pandoc/Writers/Textile.hs8
-rw-r--r--src/Text/Pandoc/Writers/ZimWiki.hs11
-rw-r--r--src/Text/Pandoc/XML.hs14
37 files changed, 836 insertions, 1356 deletions
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index cd71448fe..34b04b266 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -315,18 +315,14 @@ readFileFromDirs (d:ds) f = catchError
(\_ -> readFileFromDirs ds f)
instance TemplateMonad PandocIO where
- getPartial fp =
- lift $ UTF8.toText <$>
- catchError (readFileStrict fp)
- (\_ -> readDataFile ("templates" </> fp))
+ getPartial fp = UTF8.toText <$> catchError
+ (readFileStrict fp)
+ (\_ -> readDataFile ("templates" </> fp))
instance TemplateMonad PandocPure where
- getPartial fp =
- lift $ UTF8.toText <$>
- catchError (readFileStrict fp)
- (\_ -> readDataFile ("templates" </> fp))
-
---
+ getPartial fp = UTF8.toText <$> catchError
+ (readFileStrict fp)
+ (\_ -> readDataFile ("templates" </> fp))
-- | 'CommonState' represents state that is used by all
-- instances of 'PandocMonad'. Normally users should not
diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs
index 6a1bb0862..6b5dbfb47 100644
--- a/src/Text/Pandoc/PDF.hs
+++ b/src/Text/Pandoc/PDF.hs
@@ -46,7 +46,7 @@ import System.Process (readProcessWithExitCode)
import Text.Pandoc.Shared (inDirectory, stringify)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Walk (walkM)
-import Text.Pandoc.Writers.Shared (getField, metaToJSON)
+import Text.Pandoc.Writers.Shared (getField, metaToContext)
#ifdef _WINDOWS
import Data.List (intercalate)
#endif
@@ -134,22 +134,22 @@ makeWithWkhtmltopdf program pdfargs writer opts doc@(Pandoc meta _) = do
MathJax _ -> ["--run-script", "MathJax.Hub.Register.StartupHook('End Typeset', function() { window.status = 'mathjax_loaded' });",
"--window-status", "mathjax_loaded"]
_ -> []
- meta' <- metaToJSON opts (return . stringify) (return . stringify) meta
+ meta' <- metaToContext opts (return . stringify) (return . stringify) meta
let toArgs (f, mbd) = maybe [] (\d -> ['-':'-':f, d]) mbd
let args = pdfargs ++ mathArgs ++ concatMap toArgs
[("page-size", getField "papersize" meta')
,("title", getField "title" meta')
- ,("margin-bottom", fromMaybe (Just "1.2in")
+ ,("margin-bottom", maybe (Just "1.2in") Just
(getField "margin-bottom" meta'))
- ,("margin-top", fromMaybe (Just "1.25in")
+ ,("margin-top", maybe (Just "1.25in") Just
(getField "margin-top" meta'))
- ,("margin-right", fromMaybe (Just "1.25in")
+ ,("margin-right", maybe (Just "1.25in") Just
(getField "margin-right" meta'))
- ,("margin-left", fromMaybe (Just "1.25in")
+ ,("margin-left", maybe (Just "1.25in") Just
(getField "margin-left" meta'))
- ,("footer-html", fromMaybe Nothing
+ ,("footer-html", maybe Nothing Just
(getField "footer-html" meta'))
- ,("header-html", fromMaybe Nothing
+ ,("header-html", maybe Nothing Just
(getField "header-html" meta'))
]
source <- writer opts doc
diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs
deleted file mode 100644
index ad223274e..000000000
--- a/src/Text/Pandoc/Pretty.hs
+++ /dev/null
@@ -1,543 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{- |
- Module : Text.Pandoc.Pretty
- Copyright : Copyright (C) 2010-2019 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-A prettyprinting library for the production of text documents,
-including wrapped text, indentated blocks, and tables.
--}
-
-module Text.Pandoc.Pretty (
- Doc
- , render
- , cr
- , blankline
- , blanklines
- , space
- , text
- , char
- , prefixed
- , flush
- , nest
- , hang
- , beforeNonBlank
- , nowrap
- , afterBreak
- , offset
- , minOffset
- , height
- , lblock
- , cblock
- , rblock
- , (<>)
- , (<+>)
- , ($$)
- , ($+$)
- , isEmpty
- , empty
- , cat
- , hcat
- , hsep
- , vcat
- , vsep
- , nestle
- , chomp
- , inside
- , braces
- , brackets
- , parens
- , quotes
- , doubleQuotes
- , charWidth
- , realLength
- )
-
-where
-import Prelude
-import Control.Monad
-import Control.Monad.State.Strict
-import Data.Char (isSpace)
-import Data.Foldable (toList)
-import Data.List (intersperse, foldl')
-import Data.Sequence (Seq, ViewL (..), fromList, mapWithIndex, singleton, viewl,
- (<|))
-import qualified Data.Sequence as Seq
-import Data.String
-
-data RenderState a = RenderState{
- output :: [a] -- ^ In reverse order
- , prefix :: String
- , usePrefix :: Bool
- , lineLength :: Maybe Int -- ^ 'Nothing' means no wrapping
- , column :: Int
- , newlines :: Int -- ^ Number of preceding newlines
- }
-
-type DocState a = State (RenderState a) ()
-
-data D = Text Int String
- | Block Int [String]
- | Prefixed String Doc
- | BeforeNonBlank Doc
- | Flush Doc
- | BreakingSpace
- | AfterBreak String
- | CarriageReturn
- | NewLine
- | BlankLines Int -- number of blank lines
- deriving (Show, Eq)
-
-newtype Doc = Doc { unDoc :: Seq D }
- deriving (Semigroup, Monoid, Show, Eq)
-
-instance IsString Doc where
- fromString = text
-
-isBlank :: D -> Bool
-isBlank BreakingSpace = True
-isBlank CarriageReturn = True
-isBlank NewLine = True
-isBlank (BlankLines _) = True
-isBlank (Text _ (c:_)) = isSpace c
-isBlank _ = False
-
--- | True if the document is empty.
-isEmpty :: Doc -> Bool
-isEmpty = Seq.null . unDoc
-
--- | The empty document.
-empty :: Doc
-empty = mempty
-
--- | Concatenate a list of 'Doc's.
-cat :: [Doc] -> Doc
-cat = mconcat
-
--- | Same as 'cat'.
-hcat :: [Doc] -> Doc
-hcat = mconcat
-
--- | Concatenate a list of 'Doc's, putting breakable spaces
--- between them.
-infixr 6 <+>
-(<+>) :: Doc -> Doc -> Doc
-(<+>) x y
- | isEmpty x = y
- | isEmpty y = x
- | otherwise = x <> space <> y
-
--- | Same as 'cat', but putting breakable spaces between the
--- 'Doc's.
-hsep :: [Doc] -> Doc
-hsep = foldr (<+>) empty
-
-infixr 5 $$
--- | @a $$ b@ puts @a@ above @b@.
-($$) :: Doc -> Doc -> Doc
-($$) x y
- | isEmpty x = y
- | isEmpty y = x
- | otherwise = x <> cr <> y
-
-infixr 5 $+$
--- | @a $+$ b@ puts @a@ above @b@, with a blank line between.
-($+$) :: Doc -> Doc -> Doc
-($+$) x y
- | isEmpty x = y
- | isEmpty y = x
- | otherwise = x <> blankline <> y
-
--- | List version of '$$'.
-vcat :: [Doc] -> Doc
-vcat = foldr ($$) empty
-
--- | List version of '$+$'.
-vsep :: [Doc] -> Doc
-vsep = foldr ($+$) empty
-
--- | Removes leading blank lines from a 'Doc'.
-nestle :: Doc -> Doc
-nestle (Doc d) = Doc $ go d
- where go x = case viewl x of
- (BlankLines _ :< rest) -> go rest
- (NewLine :< rest) -> go rest
- _ -> x
-
--- | Chomps trailing blank space off of a 'Doc'.
-chomp :: Doc -> Doc
-chomp d = Doc (fromList dl')
- where dl = toList (unDoc d)
- dl' = reverse $ go $ reverse dl
- go [] = []
- go (BreakingSpace : xs) = go xs
- go (CarriageReturn : xs) = go xs
- go (NewLine : xs) = go xs
- go (BlankLines _ : xs) = go xs
- go (Prefixed s d' : xs) = Prefixed s (chomp d') : xs
- go xs = xs
-
-outp :: (IsString a) => Int -> String -> DocState a
-outp off s | off < 0 = do -- offset < 0 means newline characters
- st' <- get
- let rawpref = prefix st'
- when (column st' == 0 && usePrefix st' && not (null rawpref)) $ do
- let pref = reverse $ dropWhile isSpace $ reverse rawpref
- modify $ \st -> st{ output = fromString pref : output st
- , column = column st + realLength pref }
- let numnewlines = length $ takeWhile (=='\n') $ reverse s
- modify $ \st -> st { output = fromString s : output st
- , column = 0
- , newlines = newlines st + numnewlines }
-outp off s = do -- offset >= 0 (0 might be combining char)
- st' <- get
- let pref = prefix st'
- when (column st' == 0 && usePrefix st' && not (null pref)) $
- modify $ \st -> st{ output = fromString pref : output st
- , column = column st + realLength pref }
- modify $ \st -> st{ output = fromString s : output st
- , column = column st + off
- , newlines = 0 }
-
--- | Renders a 'Doc'. @render (Just n)@ will use
--- a line length of @n@ to reflow text on breakable spaces.
--- @render Nothing@ will not reflow text.
-render :: (IsString a) => Maybe Int -> Doc -> a
-render linelen doc = fromString . mconcat . reverse . output $
- execState (renderDoc doc) startingState
- where startingState = RenderState{
- output = mempty
- , prefix = ""
- , usePrefix = True
- , lineLength = linelen
- , column = 0
- , newlines = 2 }
-
-renderDoc :: (IsString a, Monoid a)
- => Doc -> DocState a
-renderDoc = renderList . dropWhile (== BreakingSpace) . toList . unDoc
-
-data IsBlock = IsBlock Int [String]
-
--- This would be nicer with a pattern synonym
--- pattern VBlock i s <- mkIsBlock -> Just (IsBlock ..)
-
-renderList :: (IsString a, Monoid a)
- => [D] -> DocState a
-renderList [] = return ()
-renderList (Text off s : xs) = do
- outp off s
- renderList xs
-
-renderList (Prefixed pref d : xs) = do
- st <- get
- let oldPref = prefix st
- put st{ prefix = prefix st ++ pref }
- renderDoc d
- modify $ \s -> s{ prefix = oldPref }
- renderList xs
-
-renderList (Flush d : xs) = do
- st <- get
- let oldUsePrefix = usePrefix st
- put st{ usePrefix = False }
- renderDoc d
- modify $ \s -> s{ usePrefix = oldUsePrefix }
- renderList xs
-
-renderList (BeforeNonBlank d : xs) =
- case xs of
- (x:_) | isBlank x -> renderList xs
- | otherwise -> renderDoc d >> renderList xs
- [] -> renderList xs
-
-renderList [BlankLines _] = return ()
-
-renderList (BlankLines m : BlankLines n : xs) =
- renderList (BlankLines (max m n) : xs)
-
-renderList (BlankLines num : BreakingSpace : xs) =
- renderList (BlankLines num : xs)
-
-renderList (BlankLines num : xs) = do
- st <- get
- case output st of
- _ | newlines st > num -> return ()
- | otherwise -> replicateM_ (1 + num - newlines st) (outp (-1) "\n")
- renderList xs
-
-renderList (CarriageReturn : BlankLines m : xs) =
- renderList (BlankLines m : xs)
-
-renderList (CarriageReturn : BreakingSpace : xs) =
- renderList (CarriageReturn : xs)
-
-renderList (CarriageReturn : xs) = do
- st <- get
- if newlines st > 0 || null xs
- then renderList xs
- else do
- outp (-1) "\n"
- renderList xs
-
-renderList (NewLine : xs) = do
- outp (-1) "\n"
- renderList xs
-
-renderList (BreakingSpace : CarriageReturn : xs) =
- renderList (CarriageReturn:xs)
-renderList (BreakingSpace : NewLine : xs) = renderList (NewLine:xs)
-renderList (BreakingSpace : BlankLines n : xs) = renderList (BlankLines n:xs)
-renderList (BreakingSpace : BreakingSpace : xs) = renderList (BreakingSpace:xs)
-renderList (BreakingSpace : xs) = do
- let isText (Text _ _) = True
- isText (Block _ _) = True
- isText (AfterBreak _) = True
- isText _ = False
- let isBreakingSpace BreakingSpace = True
- isBreakingSpace _ = False
- let xs' = dropWhile isBreakingSpace xs
- let next = takeWhile isText xs'
- st <- get
- let off = foldl' (+) 0 $ map offsetOf next
- case lineLength st of
- Just l | column st + 1 + off > l -> do
- outp (-1) "\n"
- renderList xs'
- _ -> do
- outp 1 " "
- renderList xs'
-
-renderList (AfterBreak s : xs) = do
- st <- get
- when (newlines st > 0) $ outp (realLength s) s
- renderList xs
-
-renderList (Block i1 s1 : Block i2 s2 : xs) =
- renderList (mergeBlocks False (IsBlock i1 s1) (IsBlock i2 s2) : xs)
-
-renderList (Block i1 s1 : BreakingSpace : Block i2 s2 : xs) =
- renderList (mergeBlocks True (IsBlock i1 s1) (IsBlock i2 s2) : xs)
-
-renderList (Block _width lns : xs) = do
- st <- get
- let oldPref = prefix st
- case column st - realLength oldPref of
- n | n > 0 -> modify $ \s -> s{ prefix = oldPref ++ replicate n ' ' }
- _ -> return ()
- renderList $ intersperse CarriageReturn (map (Text 0) lns)
- modify $ \s -> s{ prefix = oldPref }
- renderList xs
-
-mergeBlocks :: Bool -> IsBlock -> IsBlock -> D
-mergeBlocks addSpace (IsBlock w1 lns1) (IsBlock w2 lns2) =
- Block (w1 + w2 + if addSpace then 1 else 0) $
- zipWith (\l1 l2 -> pad w1 l1 ++ l2) lns1' (map sp lns2')
- where (lns1', lns2') = case (length lns1, length lns2) of
- (x, y) | x > y -> (lns1,
- lns2 ++ replicate (x - y) "")
- | x < y -> (lns1 ++ replicate (y - x) "",
- lns2)
- | otherwise -> (lns1, lns2)
- pad n s = s ++ replicate (n - realLength s) ' '
- sp "" = ""
- sp xs = if addSpace then ' ' : xs else xs
-
-offsetOf :: D -> Int
-offsetOf (Text o _) = o
-offsetOf (Block w _) = w
-offsetOf BreakingSpace = 1
-offsetOf _ = 0
-
--- | A literal string.
-text :: String -> Doc
-text = Doc . toChunks
- where toChunks :: String -> Seq D
- toChunks [] = mempty
- toChunks s = case break (=='\n') s of
- ([], _:ys) -> NewLine <| toChunks ys
- (xs, _:ys) -> Text (realLength xs) xs <|
- (NewLine <| toChunks ys)
- (xs, []) -> singleton $ Text (realLength xs) xs
-
--- | A character.
-char :: Char -> Doc
-char c = text [c]
-
--- | A breaking (reflowable) space.
-space :: Doc
-space = Doc $ singleton BreakingSpace
-
--- | A carriage return. Does nothing if we're at the beginning of
--- a line; otherwise inserts a newline.
-cr :: Doc
-cr = Doc $ singleton CarriageReturn
-
--- | Inserts a blank line unless one exists already.
--- (@blankline <> blankline@ has the same effect as @blankline@.
-blankline :: Doc
-blankline = Doc $ singleton (BlankLines 1)
-
--- | Inserts blank lines unless they exist already.
--- (@blanklines m <> blanklines n@ has the same effect as @blanklines (max m n)@.
-blanklines :: Int -> Doc
-blanklines n = Doc $ singleton (BlankLines n)
-
--- | Uses the specified string as a prefix for every line of
--- the inside document (except the first, if not at the beginning
--- of the line).
-prefixed :: String -> Doc -> Doc
-prefixed pref doc = Doc $ singleton $ Prefixed pref doc
-
--- | Makes a 'Doc' flush against the left margin.
-flush :: Doc -> Doc
-flush doc = Doc $ singleton $ Flush doc
-
--- | Indents a 'Doc' by the specified number of spaces.
-nest :: Int -> Doc -> Doc
-nest ind = prefixed (replicate ind ' ')
-
--- | A hanging indent. @hang ind start doc@ prints @start@,
--- then @doc@, leaving an indent of @ind@ spaces on every
--- line but the first.
-hang :: Int -> Doc -> Doc -> Doc
-hang ind start doc = start <> nest ind doc
-
--- | @beforeNonBlank d@ conditionally includes @d@ unless it is
--- followed by blank space.
-beforeNonBlank :: Doc -> Doc
-beforeNonBlank d = Doc $ singleton (BeforeNonBlank d)
-
--- | Makes a 'Doc' non-reflowable.
-nowrap :: Doc -> Doc
-nowrap doc = Doc $ mapWithIndex replaceSpace $ unDoc doc
- where replaceSpace _ BreakingSpace = Text 1 " "
- replaceSpace _ x = x
-
--- | Content to print only if it comes at the beginning of a line,
--- to be used e.g. for escaping line-initial `.` in roff man.
-afterBreak :: String -> Doc
-afterBreak s = Doc $ singleton (AfterBreak s)
-
--- | Returns the width of a 'Doc'.
-offset :: Doc -> Int
-offset d = maximum (0: map realLength (lines $ render Nothing d))
-
--- | Returns the minimal width of a 'Doc' when reflowed at breakable spaces.
-minOffset :: Doc -> Int
-minOffset d = maximum (0: map realLength (lines $ render (Just 0) d))
-
--- | @lblock n d@ is a block of width @n@ characters, with
--- text derived from @d@ and aligned to the left.
-lblock :: Int -> Doc -> Doc
-lblock = block id
-
--- | Like 'lblock' but aligned to the right.
-rblock :: Int -> Doc -> Doc
-rblock w = block (\s -> replicate (w - realLength s) ' ' ++ s) w
-
--- | Like 'lblock' but aligned centered.
-cblock :: Int -> Doc -> Doc
-cblock w = block (\s -> replicate ((w - realLength s) `div` 2) ' ' ++ s) w
-
--- | Returns the height of a block or other 'Doc'.
-height :: Doc -> Int
-height = length . lines . render Nothing
-
-block :: (String -> String) -> Int -> Doc -> Doc
-block filler width d
- | width < 1 && not (isEmpty d) = block filler 1 d
- | otherwise = Doc $ singleton $ Block width $ map filler
- $ chop width $ render (Just width) d
-
-chop :: Int -> String -> [String]
-chop _ [] = []
-chop n cs = case break (=='\n') cs of
- (xs, ys) -> if len <= n
- then case ys of
- [] -> [xs]
- ['\n'] -> [xs]
- (_:zs) -> xs : chop n zs
- else take n xs : chop n (drop n xs ++ ys)
- where len = realLength xs
-
--- | Encloses a 'Doc' inside a start and end 'Doc'.
-inside :: Doc -> Doc -> Doc -> Doc
-inside start end contents =
- start <> contents <> end
-
--- | Puts a 'Doc' in curly braces.
-braces :: Doc -> Doc
-braces = inside (char '{') (char '}')
-
--- | Puts a 'Doc' in square brackets.
-brackets :: Doc -> Doc
-brackets = inside (char '[') (char ']')
-
--- | Puts a 'Doc' in parentheses.
-parens :: Doc -> Doc
-parens = inside (char '(') (char ')')
-
--- | Wraps a 'Doc' in single quotes.
-quotes :: Doc -> Doc
-quotes = inside (char '\'') (char '\'')
-
--- | Wraps a 'Doc' in double quotes.
-doubleQuotes :: Doc -> Doc
-doubleQuotes = inside (char '"') (char '"')
-
--- | Returns width of a character in a monospace font: 0 for a combining
--- character, 1 for a regular character, 2 for an East Asian wide character.
-charWidth :: Char -> Int
-charWidth c =
- case c of
- _ | c < '\x0300' -> 1
- | c >= '\x0300' && c <= '\x036F' -> 0 -- combining
- | c >= '\x0370' && c <= '\x10FC' -> 1
- | c >= '\x1100' && c <= '\x115F' -> 2
- | c >= '\x1160' && c <= '\x11A2' -> 1
- | c >= '\x11A3' && c <= '\x11A7' -> 2
- | c >= '\x11A8' && c <= '\x11F9' -> 1
- | c >= '\x11FA' && c <= '\x11FF' -> 2
- | c >= '\x1200' && c <= '\x2328' -> 1
- | c >= '\x2329' && c <= '\x232A' -> 2
- | c >= '\x232B' && c <= '\x2E31' -> 1
- | c >= '\x2E80' && c <= '\x303E' -> 2
- | c == '\x303F' -> 1
- | c >= '\x3041' && c <= '\x3247' -> 2
- | c >= '\x3248' && c <= '\x324F' -> 1 -- ambiguous
- | c >= '\x3250' && c <= '\x4DBF' -> 2
- | c >= '\x4DC0' && c <= '\x4DFF' -> 1
- | c >= '\x4E00' && c <= '\xA4C6' -> 2
- | c >= '\xA4D0' && c <= '\xA95F' -> 1
- | c >= '\xA960' && c <= '\xA97C' -> 2
- | c >= '\xA980' && c <= '\xABF9' -> 1
- | c >= '\xAC00' && c <= '\xD7FB' -> 2
- | c >= '\xD800' && c <= '\xDFFF' -> 1
- | c >= '\xE000' && c <= '\xF8FF' -> 1 -- ambiguous
- | c >= '\xF900' && c <= '\xFAFF' -> 2
- | c >= '\xFB00' && c <= '\xFDFD' -> 1
- | c >= '\xFE00' && c <= '\xFE0F' -> 1 -- ambiguous
- | c >= '\xFE10' && c <= '\xFE19' -> 2
- | c >= '\xFE20' && c <= '\xFE26' -> 1
- | c >= '\xFE30' && c <= '\xFE6B' -> 2
- | c >= '\xFE70' && c <= '\xFEFF' -> 1
- | c >= '\xFF01' && c <= '\xFF60' -> 2
- | c >= '\xFF61' && c <= '\x16A38' -> 1
- | c >= '\x1B000' && c <= '\x1B001' -> 2
- | c >= '\x1D000' && c <= '\x1F1FF' -> 1
- | c >= '\x1F200' && c <= '\x1F251' -> 2
- | c >= '\x1F300' && c <= '\x1F773' -> 1
- | c >= '\x20000' && c <= '\x3FFFD' -> 2
- | otherwise -> 1
-
--- | Get real length of string, taking into account combining and double-wide
--- characters.
-realLength :: String -> Int
-realLength = foldl' (+) 0 . map charWidth
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index a17c1fff2..7c3546f44 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -128,7 +128,7 @@ import Text.Pandoc.Asciify (toAsciiChar)
import Text.Pandoc.Definition
import Text.Pandoc.Extensions (Extensions, Extension(..), extensionEnabled)
import Text.Pandoc.Generic (bottomUp)
-import Text.Pandoc.Pretty (charWidth)
+import Text.DocLayout (charWidth)
import Text.Pandoc.Walk
-- | Version number of pandoc library.
diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs
index 36eacfdd8..640197c45 100644
--- a/src/Text/Pandoc/Templates.hs
+++ b/src/Text/Pandoc/Templates.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Templates
@@ -8,8 +10,7 @@
Stability : alpha
Portability : portable
-A simple templating system with variable substitution and conditionals.
-
+Utility functions for working with pandoc templates.
-}
module Text.Pandoc.Templates ( Template
@@ -52,3 +53,5 @@ getDefaultTemplate writer = do
_ -> do
let fname = "templates" </> "default" <.> format
UTF8.toText <$> readDataFile fname
+
+
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs
index bc895c437..38c9b3bf3 100644
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/src/Text/Pandoc/Writers/AsciiDoc.hs
@@ -26,6 +26,7 @@ import Data.Char (isPunctuation, isSpace, toLower, toUpper)
import Data.List (intercalate, intersperse, stripPrefix)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import qualified Data.Set as Set
+import qualified Data.Text as T
import Data.Text (Text)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@@ -33,7 +34,7 @@ import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, space)
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@@ -79,14 +80,11 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
- metadata <- metaToJSON opts
- (fmap render' . blockListToAsciiDoc opts)
- (fmap render' . inlineListToAsciiDoc opts)
+ metadata <- metaToContext opts
+ (blockListToAsciiDoc opts)
+ (fmap chomp . inlineListToAsciiDoc opts)
meta
- body <- vcat <$> mapM (elementToAsciiDoc 1 opts) (hierarchicalize blocks)
- let main = render colwidth body
+ main <- vcat <$> mapM (elementToAsciiDoc 1 opts) (hierarchicalize blocks)
st <- get
let context = defField "body" main
$ defField "toc"
@@ -94,13 +92,13 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do
isJust (writerTemplate opts))
$ defField "math" (hasMath st)
$ defField "titleblock" titleblock metadata
- return $
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
elementToAsciiDoc :: PandocMonad m
- => Int -> WriterOptions -> Element -> ADW m Doc
+ => Int -> WriterOptions -> Element -> ADW m (Doc Text)
elementToAsciiDoc _ opts (Blk b) = blockToAsciiDoc opts b
elementToAsciiDoc nestlevel opts (Sec _lvl _num attr label children) = do
hdr <- blockToAsciiDoc opts (Header nestlevel attr label)
@@ -137,7 +135,7 @@ needsEscaping s = beginsWithOrderedListMarker s || isBracketed s
blockToAsciiDoc :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> ADW m Doc
+ -> ADW m (Doc Text)
blockToAsciiDoc _ Null = return empty
blockToAsciiDoc opts (Plain inlines) = do
contents <- inlineListToAsciiDoc opts inlines
@@ -147,7 +145,7 @@ blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) =
blockToAsciiDoc opts (Para inlines) = do
contents <- inlineListToAsciiDoc opts inlines
-- escape if para starts with ordered list marker
- let esc = if needsEscaping (render Nothing contents)
+ let esc = if needsEscaping (T.unpack $ render Nothing contents)
then text "{empty}"
else empty
return $ esc <> contents <> blankline
@@ -257,7 +255,7 @@ blockToAsciiDoc opts (BulletList items) = do
modify $ \st -> st{ inList = True }
contents <- mapM (bulletListItemToAsciiDoc opts) items
modify $ \st -> st{ inList = inlist }
- return $ cat contents <> blankline
+ return $ mconcat contents <> blankline
blockToAsciiDoc opts (OrderedList (start, sty, _delim) items) = do
let listStyle = case sty of
DefaultStyle -> []
@@ -272,13 +270,13 @@ blockToAsciiDoc opts (OrderedList (start, sty, _delim) items) = do
modify $ \st -> st{ inList = True }
contents <- mapM (orderedListItemToAsciiDoc opts) items
modify $ \st -> st{ inList = inlist }
- return $ listoptions $$ cat contents <> blankline
+ return $ listoptions $$ mconcat contents <> blankline
blockToAsciiDoc opts (DefinitionList items) = do
inlist <- gets inList
modify $ \st -> st{ inList = True }
contents <- mapM (definitionListItemToAsciiDoc opts) items
modify $ \st -> st{ inList = inlist }
- return $ cat contents <> blankline
+ return $ mconcat contents <> blankline
blockToAsciiDoc opts (Div (ident,classes,_) bs) = do
let identifier = if null ident then empty else "[[" <> text ident <> "]]"
let admonitions = ["attention","caution","danger","error","hint",
@@ -305,7 +303,7 @@ blockToAsciiDoc opts (Div (ident,classes,_) bs) = do
-- | Convert bullet list item (list of blocks) to asciidoc.
bulletListItemToAsciiDoc :: PandocMonad m
- => WriterOptions -> [Block] -> ADW m Doc
+ => WriterOptions -> [Block] -> ADW m (Doc Text)
bulletListItemToAsciiDoc opts blocks = do
lev <- gets bulletListLevel
modify $ \s -> s{ bulletListLevel = lev + 1 }
@@ -315,7 +313,8 @@ bulletListItemToAsciiDoc opts blocks = do
return $ marker <> text " " <> listBegin blocks <>
contents <> cr
-addBlock :: PandocMonad m => WriterOptions -> Doc -> Block -> ADW m Doc
+addBlock :: PandocMonad m
+ => WriterOptions -> Doc Text -> Block -> ADW m (Doc Text)
addBlock opts d b = do
x <- chomp <$> blockToAsciiDoc opts b
return $
@@ -328,7 +327,7 @@ addBlock opts d b = do
Plain{} | isEmpty d -> x
_ -> d <> cr <> text "+" <> cr <> x
-listBegin :: [Block] -> Doc
+listBegin :: [Block] -> Doc Text
listBegin blocks =
case blocks of
Para (Math DisplayMath _:_) : _ -> "{blank}"
@@ -342,7 +341,7 @@ listBegin blocks =
orderedListItemToAsciiDoc :: PandocMonad m
=> WriterOptions -- ^ options
-> [Block] -- ^ list item (list of blocks)
- -> ADW m Doc
+ -> ADW m (Doc Text)
orderedListItemToAsciiDoc opts blocks = do
lev <- gets orderedListLevel
modify $ \s -> s{ orderedListLevel = lev + 1 }
@@ -355,7 +354,7 @@ orderedListItemToAsciiDoc opts blocks = do
definitionListItemToAsciiDoc :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
- -> ADW m Doc
+ -> ADW m (Doc Text)
definitionListItemToAsciiDoc opts (label, defs) = do
labelText <- inlineListToAsciiDoc opts label
marker <- gets defListMarker
@@ -363,7 +362,7 @@ definitionListItemToAsciiDoc opts (label, defs) = do
then modify (\st -> st{ defListMarker = ";;"})
else modify (\st -> st{ defListMarker = "::"})
let divider = cr <> text "+" <> cr
- let defsToAsciiDoc :: PandocMonad m => [Block] -> ADW m Doc
+ let defsToAsciiDoc :: PandocMonad m => [Block] -> ADW m (Doc Text)
defsToAsciiDoc ds = (vcat . intersperse divider . map chomp)
`fmap` mapM (blockToAsciiDoc opts) ds
defs' <- mapM defsToAsciiDoc defs
@@ -375,13 +374,14 @@ definitionListItemToAsciiDoc opts (label, defs) = do
blockListToAsciiDoc :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
- -> ADW m Doc
-blockListToAsciiDoc opts blocks = cat `fmap` mapM (blockToAsciiDoc opts) blocks
+ -> ADW m (Doc Text)
+blockListToAsciiDoc opts blocks =
+ mconcat `fmap` mapM (blockToAsciiDoc opts) blocks
data SpacyLocation = End | Start
-- | Convert list of Pandoc inline elements to asciidoc.
-inlineListToAsciiDoc :: PandocMonad m => WriterOptions -> [Inline] -> ADW m Doc
+inlineListToAsciiDoc :: PandocMonad m => WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc opts lst = do
oldIntraword <- gets intraword
setIntraword False
@@ -424,7 +424,7 @@ withIntraword :: PandocMonad m => ADW m a -> ADW m a
withIntraword p = setIntraword True *> p <* setIntraword False
-- | Convert Pandoc inline element to asciidoc.
-inlineToAsciiDoc :: PandocMonad m => WriterOptions -> Inline -> ADW m Doc
+inlineToAsciiDoc :: PandocMonad m => WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc opts (Emph [Strong xs]) =
inlineToAsciiDoc opts (Strong [Emph xs]) -- see #5565
inlineToAsciiDoc opts (Emph lst) = do
@@ -529,7 +529,7 @@ inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do
dimList = showDim Width ++ showDim Height
dims = if null dimList
then empty
- else "," <> cat (intersperse "," dimList)
+ else "," <> mconcat (intersperse "," dimList)
return $ "image:" <> text src <> "[" <> linktext <> linktitle <> dims <> "]"
inlineToAsciiDoc opts (Note [Para inlines]) =
inlineToAsciiDoc opts (Note [Plain inlines])
diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs
index c62a03097..a572123fc 100644
--- a/src/Text/Pandoc/Writers/CommonMark.hs
+++ b/src/Text/Pandoc/Writers/CommonMark.hs
@@ -49,9 +49,9 @@ writeCommonMark opts (Pandoc meta blocks) = do
then []
else [OrderedList (1, Decimal, Period) $ reverse notes]
main <- blocksToCommonMark opts (blocks' ++ notes')
- metadata <- metaToJSON opts
- (blocksToCommonMark opts)
- (inlinesToCommonMark opts)
+ metadata <- metaToContext opts
+ (fmap T.stripEnd . blocksToCommonMark opts)
+ (fmap T.stripEnd . inlinesToCommonMark opts)
meta
let context =
-- for backwards compatibility we populate toc
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index aa4c6ae5f..3a142fdb8 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -19,6 +19,7 @@ import Data.Char (ord, isDigit, toLower)
import Data.List (intercalate, intersperse)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
+import qualified Data.Text as T
import Network.URI (unEscapeString)
import Text.Pandoc.BCP47
import Text.Pandoc.Class (PandocMonad, report, toLang)
@@ -26,7 +27,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Walk (query)
@@ -60,16 +61,15 @@ pandocToConTeXt options (Pandoc meta blocks) = do
let colwidth = if writerWrapText options == WrapAuto
then Just $ writerColumns options
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
- metadata <- metaToJSON options
- (fmap render' . blockListToConTeXt)
- (fmap render' . inlineListToConTeXt)
+ metadata <- metaToContext options
+ blockListToConTeXt
+ (fmap chomp . inlineListToConTeXt)
meta
body <- mapM (elementToConTeXt options) $ hierarchicalize blocks
- let main = (render' . vcat) body
- let layoutFromMargins = intercalate [','] $ mapMaybe (\(x,y) ->
- ((x ++ "=") ++) <$> getField y metadata)
+ let main = vcat body
+ let layoutFromMargins = mconcat $ intersperse ("," :: Doc Text) $
+ mapMaybe (\(x,y) ->
+ ((x <> "=") <>) <$> getField y metadata)
[("leftmargin","margin-left")
,("rightmargin","margin-right")
,("top","margin-top")
@@ -77,7 +77,8 @@ pandocToConTeXt options (Pandoc meta blocks) = do
]
mblang <- fromBCP47 (getLang options meta)
let context = defField "toc" (writerTableOfContents options)
- $ defField "placelist" (intercalate ("," :: String) $
+ $ defField "placelist"
+ (mconcat . intersperse ("," :: Doc Text) $
take (writerTOCDepth options +
case writerTopLevelDivision options of
TopLevelPart -> 0
@@ -88,26 +89,30 @@ pandocToConTeXt options (Pandoc meta blocks) = do
$ defField "body" main
$ defField "layout" layoutFromMargins
$ defField "number-sections" (writerNumberSections options)
- $ maybe id (defField "context-lang") mblang
- $ (case getField "papersize" metadata of
+ $ maybe id (\l ->
+ defField "context-lang" (text l :: Doc Text)) mblang
+ $ (case T.unpack . render Nothing <$>
+ getField "papersize" metadata of
Just (('a':d:ds) :: String)
| all isDigit (d:ds) -> resetField "papersize"
- (('A':d:ds) :: String)
+ (T.pack ('A':d:ds))
_ -> id)
$ (case toLower <$> lookupMetaString "pdfa" meta of
- "true" -> resetField "pdfa" ("1b:2005" :: String)
+ "true" -> resetField "pdfa" (T.pack "1b:2005")
_ -> id) metadata
- let context' = defField "context-dir" (toContextDir
+ let context' = defField "context-dir" (maybe mempty toContextDir
$ getField "dir" context) context
- return $
+ return $ render colwidth $
case writerTemplate options of
Nothing -> main
Just tpl -> renderTemplate tpl context'
-toContextDir :: Maybe String -> String
-toContextDir (Just "rtl") = "r2l"
-toContextDir (Just "ltr") = "l2r"
-toContextDir _ = ""
+-- change rtl to r2l, ltr to l2r
+toContextDir :: Doc Text -> Doc Text
+toContextDir = fmap (\t -> case t of
+ "ltr" -> "l2r"
+ "rtl" -> "r2l"
+ _ -> t)
-- | escape things as needed for ConTeXt
escapeCharForConTeXt :: WriterOptions -> Char -> String
@@ -143,7 +148,7 @@ toLabel z = concatMap go z
| otherwise = [x]
-- | Convert Elements to ConTeXt
-elementToConTeXt :: PandocMonad m => WriterOptions -> Element -> WM m Doc
+elementToConTeXt :: PandocMonad m => WriterOptions -> Element -> WM m (Doc Text)
elementToConTeXt _ (Blk block) = blockToConTeXt block
elementToConTeXt opts (Sec level _ attr title' elements) = do
header' <- sectionHeader attr level title'
@@ -152,7 +157,7 @@ elementToConTeXt opts (Sec level _ attr title' elements) = do
return $ header' $$ vcat innerContents $$ footer'
-- | Convert Pandoc block element to ConTeXt.
-blockToConTeXt :: PandocMonad m => Block -> WM m Doc
+blockToConTeXt :: PandocMonad m => Block -> WM m (Doc Text)
blockToConTeXt Null = return empty
blockToConTeXt (Plain lst) = inlineListToConTeXt lst
-- title beginning with fig: indicates that the image is a figure
@@ -258,7 +263,8 @@ blockToConTeXt (Table caption aligns widths heads rows) = do
else "title=" <> braces captionText
) $$ body $$ "\\stopplacetable" <> blankline
-tableToConTeXt :: PandocMonad m => Tabl -> Doc -> [Doc] -> WM m Doc
+tableToConTeXt :: PandocMonad m
+ => Tabl -> Doc Text -> [Doc Text] -> WM m (Doc Text)
tableToConTeXt Xtb heads rows =
return $ "\\startxtable" $$
(if isEmpty heads
@@ -280,7 +286,7 @@ tableToConTeXt Ntb heads rows =
"\\startTABLEfoot" $$ last rows $$ "\\stopTABLEfoot") $$
"\\stopTABLE"
-tableRowToConTeXt :: PandocMonad m => Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m Doc
+tableRowToConTeXt :: PandocMonad m => Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text)
tableRowToConTeXt Xtb aligns widths cols = do
cells <- mapM (tableColToConTeXt Xtb) $ zip3 aligns widths cols
return $ "\\startxrow" $$ vcat cells $$ "\\stopxrow"
@@ -288,7 +294,7 @@ tableRowToConTeXt Ntb aligns widths cols = do
cells <- mapM (tableColToConTeXt Ntb) $ zip3 aligns widths cols
return $ vcat cells $$ "\\NC\\NR"
-tableColToConTeXt :: PandocMonad m => Tabl -> (Alignment, Double, [Block]) -> WM m Doc
+tableColToConTeXt :: PandocMonad m => Tabl -> (Alignment, Double, [Block]) -> WM m (Doc Text)
tableColToConTeXt tabl (align, width, blocks) = do
cellContents <- blockListToConTeXt blocks
let colwidth = if width == 0
@@ -301,23 +307,24 @@ tableColToConTeXt tabl (align, width, blocks) = do
where keys = hcat $ intersperse "," $ filter (not . isEmpty) [halign, colwidth]
tableCellToConTeXt tabl options cellContents
-tableCellToConTeXt :: PandocMonad m => Tabl -> Doc -> Doc -> WM m Doc
+tableCellToConTeXt :: PandocMonad m
+ => Tabl -> Doc Text -> Doc Text -> WM m (Doc Text)
tableCellToConTeXt Xtb options cellContents =
return $ "\\startxcell" <> options <> cellContents <> " \\stopxcell"
tableCellToConTeXt Ntb options cellContents =
return $ "\\NC" <> options <> cellContents
-alignToConTeXt :: Alignment -> Doc
+alignToConTeXt :: Alignment -> Doc Text
alignToConTeXt align = case align of
AlignLeft -> "align=right"
AlignRight -> "align=left"
AlignCenter -> "align=middle"
AlignDefault -> empty
-listItemToConTeXt :: PandocMonad m => [Block] -> WM m Doc
+listItemToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt list = (("\\item" $$) . nest 2) <$> blockListToConTeXt list
-defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m Doc
+defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m (Doc Text)
defListItemToConTeXt (term, defs) = do
term' <- inlineListToConTeXt term
def' <- liftM vsep $ mapM blockListToConTeXt defs
@@ -325,13 +332,13 @@ defListItemToConTeXt (term, defs) = do
"\\stopdescription" <> blankline
-- | Convert list of block elements to ConTeXt.
-blockListToConTeXt :: PandocMonad m => [Block] -> WM m Doc
+blockListToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt lst = liftM vcat $ mapM blockToConTeXt lst
-- | Convert list of inline elements to ConTeXt.
inlineListToConTeXt :: PandocMonad m
=> [Inline] -- ^ Inlines to convert
- -> WM m Doc
+ -> WM m (Doc Text)
inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt $ addStruts lst
-- We add a \strut after a line break that precedes a space,
-- or the space gets swallowed
@@ -347,7 +354,7 @@ inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt $ addStruts lst
-- | Convert inline element to ConTeXt
inlineToConTeXt :: PandocMonad m
=> Inline -- ^ Inline to convert
- -> WM m Doc
+ -> WM m (Doc Text)
inlineToConTeXt (Emph lst) = do
contents <- inlineListToConTeXt lst
return $ braces $ "\\em " <> contents
@@ -435,7 +442,7 @@ inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do
dimList = showDim Width ++ showDim Height
dims = if null dimList
then empty
- else brackets $ cat (intersperse "," dimList)
+ else brackets $ mconcat (intersperse "," dimList)
clas = if null cls
then empty
else brackets $ text $ toLabel $ head cls
@@ -454,8 +461,8 @@ inlineToConTeXt (Note contents) = do
codeBlock _ = []
let codeBlocks = query codeBlock contents
return $ if null codeBlocks
- then text "\\footnote{" <> nest 2 contents' <> char '}'
- else text "\\startbuffer " <> nest 2 contents' <>
+ then text "\\footnote{" <> nest 2 (chomp contents') <> char '}'
+ else text "\\startbuffer " <> nest 2 (chomp contents') <>
text "\\stopbuffer\\footnote{\\getbuffer}"
inlineToConTeXt (Span (_,_,kvs) ils) = do
mblang <- fromBCP47 (lookup "lang" kvs)
@@ -474,7 +481,7 @@ sectionHeader :: PandocMonad m
=> Attr
-> Int
-> [Inline]
- -> WM m Doc
+ -> WM m (Doc Text)
sectionHeader (ident,classes,kvs) hdrLevel lst = do
opts <- gets stOptions
contents <- inlineListToConTeXt lst
@@ -495,7 +502,7 @@ sectionHeader (ident,classes,kvs) hdrLevel lst = do
return $ starter <> levelText <> options <> blankline
-- | Craft the section footer
-sectionFooter :: PandocMonad m => Attr -> Int -> WM m Doc
+sectionFooter :: PandocMonad m => Attr -> Int -> WM m (Doc Text)
sectionFooter attr hdrLevel = do
opts <- gets stOptions
levelText <- sectionLevelToText opts attr hdrLevel
@@ -504,7 +511,7 @@ sectionFooter attr hdrLevel = do
else empty
-- | Generate a textual representation of the section level
-sectionLevelToText :: PandocMonad m => WriterOptions -> Attr -> Int -> WM m Doc
+sectionLevelToText :: PandocMonad m => WriterOptions -> Attr -> Int -> WM m (Doc Text)
sectionLevelToText opts (_,classes,_) hdrLevel = do
let level' = case writerTopLevelDivision opts of
TopLevelPart -> hdrLevel - 2
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 7d85a262d..6afa824da 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -29,7 +29,7 @@ import Text.Pandoc.Lua (Global (..), LuaException (LuaException),
runLua, setGlobals)
import Text.Pandoc.Lua.Util (addField, dofileWithTraceback)
import Text.Pandoc.Options
-import Text.Pandoc.Templates
+import Text.Pandoc.Templates (renderTemplate)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Writers.Shared
@@ -100,7 +100,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
when (stat /= Lua.OK) $
Lua.tostring' (-1) >>= throw . PandocLuaException . UTF8.toString
rendered <- docToCustom opts doc
- context <- metaToJSON opts
+ context <- metaToContext opts
blockListToCustom
inlineListToCustom
meta
@@ -108,9 +108,9 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
let (body, context) = case res of
Left (LuaException msg) -> throw (PandocLuaException msg)
Right x -> x
- return $
+ return $ pack $
case writerTemplate opts of
- Nothing -> pack body
+ Nothing -> body
Just tpl -> renderTemplate tpl $ setField "body" body context
docToCustom :: WriterOptions -> Pandoc -> Lua String
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index f3f78792b..6f42d05e3 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -20,6 +20,7 @@ import Data.Generics (everywhere, mkT)
import Data.List (isPrefixOf, stripPrefix)
import Data.Monoid (Any (..))
import Data.Text (Text)
+import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@@ -27,12 +28,12 @@ import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
-import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.XML.Light as Xml
@@ -45,7 +46,7 @@ type DB = ReaderT DocBookVersion
-- | Convert list of authors to a docbook <author> section
authorToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m B.Inlines
authorToDocbook opts name' = do
- name <- render Nothing <$> inlinesToDocbook opts name'
+ name <- T.unpack . render Nothing <$> inlinesToDocbook opts name'
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
@@ -81,8 +82,6 @@ writeDocbook opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
-- The numbering here follows LaTeX's internal numbering
let startLvl = case writerTopLevelDivision opts of
TopLevelPart -> -1
@@ -91,26 +90,25 @@ writeDocbook opts (Pandoc meta blocks) = do
TopLevelDefault -> 1
auths' <- mapM (authorToDocbook opts) $ docAuthors meta
let meta' = B.setMeta "author" auths' meta
- metadata <- metaToJSON opts
- (fmap (render' . vcat) .
+ metadata <- metaToContext opts
+ (fmap vcat .
mapM (elementToDocbook opts startLvl) .
hierarchicalize)
- (fmap render' . inlinesToDocbook opts)
+ (inlinesToDocbook opts)
meta'
- main <- (render' . vcat) <$> mapM (elementToDocbook opts startLvl) elements
+ main <- vcat <$> mapM (elementToDocbook opts startLvl) elements
let context = defField "body" main
- $
- defField "mathml" (case writerHTMLMathMethod opts of
+ $ defField "mathml" (case writerHTMLMathMethod opts of
MathML -> True
_ -> False) metadata
- return $
- (if writerPreferAscii opts then toEntities else id) $
+ return $ render colwidth $
+ (if writerPreferAscii opts then fmap toEntities else id) $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Convert an Element to Docbook.
-elementToDocbook :: PandocMonad m => WriterOptions -> Int -> Element -> DB m Doc
+elementToDocbook :: PandocMonad m => WriterOptions -> Int -> Element -> DB m (Doc Text)
elementToDocbook opts _ (Blk block) = blockToDocbook opts block
elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) = do
version <- ask
@@ -138,7 +136,7 @@ elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) = do
inTagsSimple "title" title' $$ vcat contents
-- | Convert a list of Pandoc blocks to Docbook.
-blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m Doc
+blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook opts = fmap vcat . mapM (blockToDocbook opts)
-- | Auxiliary function to convert Plain block to Para.
@@ -149,13 +147,13 @@ plainToPara x = x
-- | Convert a list of pairs of terms and definitions into a list of
-- Docbook varlistentrys.
deflistItemsToDocbook :: PandocMonad m
- => WriterOptions -> [([Inline],[[Block]])] -> DB m Doc
+ => WriterOptions -> [([Inline],[[Block]])] -> DB m (Doc Text)
deflistItemsToDocbook opts items =
vcat <$> mapM (uncurry (deflistItemToDocbook opts)) items
-- | Convert a term and a list of blocks into a Docbook varlistentry.
deflistItemToDocbook :: PandocMonad m
- => WriterOptions -> [Inline] -> [[Block]] -> DB m Doc
+ => WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocbook opts term defs = do
term' <- inlinesToDocbook opts term
def' <- blocksToDocbook opts $ concatMap (map plainToPara) defs
@@ -164,15 +162,15 @@ deflistItemToDocbook opts term defs = do
inTagsIndented "listitem" def'
-- | Convert a list of lists of blocks to a list of Docbook list items.
-listItemsToDocbook :: PandocMonad m => WriterOptions -> [[Block]] -> DB m Doc
+listItemsToDocbook :: PandocMonad m => WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook opts items = vcat <$> mapM (listItemToDocbook opts) items
-- | Convert a list of blocks into a Docbook list item.
-listItemToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m Doc
+listItemToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocbook opts item =
inTagsIndented "listitem" <$> blocksToDocbook opts (map plainToPara item)
-imageToDocbook :: WriterOptions -> Attr -> String -> Doc
+imageToDocbook :: WriterOptions -> Attr -> String -> Doc Text
imageToDocbook _ attr src = selfClosingTag "imagedata" $
("fileref", src) : idAndRole attr ++ dims
where
@@ -182,7 +180,7 @@ imageToDocbook _ attr src = selfClosingTag "imagedata" $
Nothing -> []
-- | Convert a Pandoc block element to Docbook.
-blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m Doc
+blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook _ Null = return empty
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
@@ -312,23 +310,23 @@ alignmentToString alignment = case alignment of
tableRowToDocbook :: PandocMonad m
=> WriterOptions
-> [[Block]]
- -> DB m Doc
+ -> DB m (Doc Text)
tableRowToDocbook opts cols =
(inTagsIndented "row" . vcat) <$> mapM (tableItemToDocbook opts) cols
tableItemToDocbook :: PandocMonad m
=> WriterOptions
-> [Block]
- -> DB m Doc
+ -> DB m (Doc Text)
tableItemToDocbook opts item =
(inTags True "entry" [] . vcat) <$> mapM (blockToDocbook opts) item
-- | Convert a list of inline elements to Docbook.
-inlinesToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m Doc
+inlinesToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook opts lst = hcat <$> mapM (inlineToDocbook opts) lst
-- | Convert an inline element to Docbook.
-inlineToDocbook :: PandocMonad m => WriterOptions -> Inline -> DB m Doc
+inlineToDocbook :: PandocMonad m => WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook _ (Str str) = return $ text $ escapeStringForXML str
inlineToDocbook opts (Emph lst) =
inTagsSimple "emphasis" <$> inlinesToDocbook opts lst
diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs
index fd2f9a098..e77dfff22 100644
--- a/src/Text/Pandoc/Writers/DokuWiki.hs
+++ b/src/Text/Pandoc/Writers/DokuWiki.hs
@@ -37,7 +37,7 @@ import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContent
import Text.Pandoc.Shared (camelCaseToHyphenated, escapeURI, isURI, linesToPara,
removeFormatting, substitute, trimr)
import Text.Pandoc.Templates (renderTemplate)
-import Text.Pandoc.Writers.Shared (defField, metaToJSON)
+import Text.Pandoc.Writers.Shared (defField, metaToContext)
data WriterState = WriterState {
}
@@ -70,15 +70,15 @@ runDokuWiki = flip evalStateT def . flip runReaderT def
pandocToDokuWiki :: PandocMonad m
=> WriterOptions -> Pandoc -> DokuWiki m Text
pandocToDokuWiki opts (Pandoc meta blocks) = do
- metadata <- metaToJSON opts
+ metadata <- metaToContext opts
(fmap trimr . blockListToDokuWiki opts)
- (inlineListToDokuWiki opts)
+ (fmap trimr . inlineListToDokuWiki opts)
meta
body <- blockListToDokuWiki opts blocks
- let main = pack body
+ let main = body
let context = defField "body" main
- $ defField "toc" (writerTableOfContents opts) metadata
- return $
+ $ defField "toc" (writerTableOfContents opts) metadata
+ return $ pack $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index de1a98173..af0780e99 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -36,6 +36,7 @@ import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
import qualified Data.Set as Set
import Data.String (fromString)
import Data.Text (Text)
+import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Network.HTTP (urlEncode)
import Network.URI (URI (..), parseURIReference)
@@ -53,7 +54,8 @@ import Text.Pandoc.ImageSize
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Slides
-import Text.Pandoc.Templates
+import Text.Pandoc.Templates (renderTemplate)
+import Text.DocTemplates (Context(..))
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
@@ -71,7 +73,6 @@ import qualified Text.Blaze.Html5 as H5
import qualified Text.Blaze.Html5.Attributes as A5
#endif
import Control.Monad.Except (throwError)
-import Data.Aeson (Value)
import System.FilePath (takeBaseName)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Text.Blaze.XHtml1.Transitional as H
@@ -215,17 +216,17 @@ writeHtmlString' st opts d = do
Nothing -> return $ renderHtml' body
Just tpl -> do
-- warn if empty lang
- when (isNothing (getField "lang" context :: Maybe String)) $
+ when (isNothing (getField "lang" context :: Maybe Text)) $
report NoLangSpecified
-- check for empty pagetitle
context' <-
case getField "pagetitle" context of
- Just (s :: String) | not (null s) -> return context
+ Just (s :: Text) | not (T.null s) -> return context
_ -> do
- let fallback = fromMaybe "Untitled" $ takeBaseName <$>
+ let fallback = maybe "Untitled" takeBaseName $
lookup "sourcefile" (writerVariables opts)
report $ NoTitleElement fallback
- return $ resetField "pagetitle" fallback context
+ return $ resetField "pagetitle" (T.pack fallback) context
return $ renderTemplate tpl
(defField "body" (renderHtml' body) context')
@@ -244,9 +245,9 @@ writeHtml' st opts d =
pandocToHtml :: PandocMonad m
=> WriterOptions
-> Pandoc
- -> StateT WriterState m (Html, Value)
+ -> StateT WriterState m (Html, Context Text)
pandocToHtml opts (Pandoc meta blocks) = do
- metadata <- metaToJSON opts
+ metadata <- metaToContext opts
(fmap renderHtml' . blockListToHtml opts)
(fmap renderHtml' . inlineListToHtml opts)
meta
@@ -298,7 +299,7 @@ pandocToHtml opts (Pandoc meta blocks) = do
let context = (if stHighlighting st
then case writerHighlightStyle opts of
Just sty -> defField "highlighting-css"
- (styleToCss sty)
+ (T.pack $ styleToCss sty)
Nothing -> id
else id) $
(if stMath st
@@ -307,7 +308,7 @@ pandocToHtml opts (Pandoc meta blocks) = do
(case writerHTMLMathMethod opts of
MathJax u -> defField "mathjax" True .
defField "mathjaxurl"
- (takeWhile (/='?') u)
+ (T.pack $ takeWhile (/='?') u)
_ -> defField "mathjax" False) $
defField "quotes" (stQuotes st) $
-- for backwards compatibility we populate toc
@@ -315,16 +316,18 @@ pandocToHtml opts (Pandoc meta blocks) = do
-- boolean:
maybe id (defField "toc") toc $
maybe id (defField "table-of-contents") toc $
- defField "author-meta" authsMeta $
- maybe id (defField "date-meta") (normalizeDate dateMeta) $
- defField "pagetitle" (stringifyHTML (docTitle meta)) $
- defField "idprefix" (writerIdentifierPrefix opts) $
+ defField "author-meta" (map T.pack authsMeta) $
+ maybe id (defField "date-meta" . T.pack)
+ (normalizeDate dateMeta) $
+ defField "pagetitle"
+ (T.pack . stringifyHTML . docTitle $ meta) $
+ defField "idprefix" (T.pack $ writerIdentifierPrefix opts) $
-- these should maybe be set in pandoc.hs
defField "slidy-url"
- ("https://www.w3.org/Talks/Tools/Slidy2" :: String) $
- defField "slideous-url" ("slideous" :: String) $
- defField "revealjs-url" ("reveal.js" :: String) $
- defField "s5-url" ("s5/default" :: String) $
+ ("https://www.w3.org/Talks/Tools/Slidy2" :: Text) $
+ defField "slideous-url" ("slideous" :: Text) $
+ defField "revealjs-url" ("reveal.js" :: Text) $
+ defField "s5-url" ("s5/default" :: Text) $
defField "html5" (stHtml5 st)
metadata
return (thebody, context)
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 5e759110c..1d70913c5 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -23,7 +23,7 @@ import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@@ -49,23 +49,20 @@ pandocToHaddock opts (Pandoc meta blocks) = do
body <- blockListToHaddock opts blocks
st <- get
notes' <- notesToHaddock opts (reverse $ stNotes st)
- let render' :: Doc -> Text
- render' = render colwidth
- let main = render' $ body <>
- (if isEmpty notes' then empty else blankline <> notes')
- metadata <- metaToJSON opts
- (fmap render' . blockListToHaddock opts)
- (fmap render' . inlineListToHaddock opts)
+ let main = body <> (if isEmpty notes' then empty else blankline <> notes')
+ metadata <- metaToContext opts
+ (blockListToHaddock opts)
+ (fmap chomp . inlineListToHaddock opts)
meta
let context = defField "body" main metadata
- return $
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Return haddock representation of notes.
notesToHaddock :: PandocMonad m
- => WriterOptions -> [[Block]] -> StateT WriterState m Doc
+ => WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text)
notesToHaddock opts notes =
if null notes
then return empty
@@ -82,7 +79,7 @@ escapeString = escapeStringUsing haddockEscapes
blockToHaddock :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> StateT WriterState m Doc
+ -> StateT WriterState m (Doc Text)
blockToHaddock _ Null = return empty
blockToHaddock opts (Div _ ils) = do
contents <- blockListToHaddock opts ils
@@ -129,7 +126,7 @@ blockToHaddock opts (Table caption aligns widths headers rows) = do
return $ prefixed "> " (tbl $$ blankline $$ caption'') $$ blankline
blockToHaddock opts (BulletList items) = do
contents <- mapM (bulletListItemToHaddock opts) items
- return $ cat contents <> blankline
+ return $ (if isTightList items then vcat else vsep) contents <> blankline
blockToHaddock opts (OrderedList (start,_,delim) items) = do
let attribs = (start, Decimal, delim)
let markers = orderedListMarkers attribs
@@ -137,69 +134,72 @@ blockToHaddock opts (OrderedList (start,_,delim) items) = do
then m ++ replicate (3 - length m) ' '
else m) markers
contents <- zipWithM (orderedListItemToHaddock opts) markers' items
- return $ cat contents <> blankline
+ return $ (if isTightList items then vcat else vsep) contents <> blankline
blockToHaddock opts (DefinitionList items) = do
contents <- mapM (definitionListItemToHaddock opts) items
- return $ cat contents <> blankline
+ return $ vcat contents <> blankline
-- | Convert bullet list item (list of blocks) to haddock
bulletListItemToHaddock :: PandocMonad m
- => WriterOptions -> [Block] -> StateT WriterState m Doc
+ => WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToHaddock opts items = do
contents <- blockListToHaddock opts items
let sps = replicate (writerTabStop opts - 2) ' '
let start = text ('-' : ' ' : sps)
- -- remove trailing blank line if it is a tight list
- let contents' = case reverse items of
- (BulletList xs:_) | isTightList xs ->
- chomp contents <> cr
- (OrderedList _ xs:_) | isTightList xs ->
- chomp contents <> cr
- _ -> contents
- return $ hang (writerTabStop opts) start $ contents' <> cr
+ return $ hang (writerTabStop opts) start contents $$
+ if endsWithPlain items
+ then cr
+ else blankline
-- | Convert ordered list item (a list of blocks) to haddock
orderedListItemToHaddock :: PandocMonad m
=> WriterOptions -- ^ options
-> String -- ^ list item marker
-> [Block] -- ^ list item (list of blocks)
- -> StateT WriterState m Doc
+ -> StateT WriterState m (Doc Text)
orderedListItemToHaddock opts marker items = do
contents <- blockListToHaddock opts items
let sps = case length marker - writerTabStop opts of
n | n > 0 -> text $ replicate n ' '
_ -> text " "
let start = text marker <> sps
- return $ hang (writerTabStop opts) start $ contents <> cr
+ return $ hang (writerTabStop opts) start contents $$
+ if endsWithPlain items
+ then cr
+ else blankline
-- | Convert definition list item (label, list of blocks) to haddock
definitionListItemToHaddock :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
- -> StateT WriterState m Doc
+ -> StateT WriterState m (Doc Text)
definitionListItemToHaddock opts (label, defs) = do
labelText <- inlineListToHaddock opts label
defs' <- mapM (mapM (blockToHaddock opts)) defs
- let contents = vcat $ map (\d -> hang 4 empty $ vcat d <> cr) defs'
- return $ nowrap (brackets labelText) <> cr <> contents <> cr
+ let contents = (if isTightList defs then vcat else vsep) $
+ map (\d -> hang 4 empty $ vcat d <> cr) defs'
+ return $ nowrap (brackets labelText) $$ contents $$
+ if isTightList defs
+ then cr
+ else blankline
-- | Convert list of Pandoc block elements to haddock
blockListToHaddock :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
- -> StateT WriterState m Doc
+ -> StateT WriterState m (Doc Text)
blockListToHaddock opts blocks =
- cat <$> mapM (blockToHaddock opts) blocks
+ mconcat <$> mapM (blockToHaddock opts) blocks
-- | Convert list of Pandoc inline elements to haddock.
inlineListToHaddock :: PandocMonad m
- => WriterOptions -> [Inline] -> StateT WriterState m Doc
+ => WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock opts lst =
- cat <$> mapM (inlineToHaddock opts) lst
+ mconcat <$> mapM (inlineToHaddock opts) lst
-- | Convert Pandoc inline element to haddock.
inlineToHaddock :: PandocMonad m
- => WriterOptions -> Inline -> StateT WriterState m Doc
+ => WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToHaddock opts (Span (ident,_,_) ils) = do
contents <- inlineListToHaddock opts ils
if not (null ident) && null ils
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index 89f4146ca..84a48d8b4 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -31,7 +31,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared (isURI, linesToPara, splitBy)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math (texMathToInlines)
@@ -136,21 +136,18 @@ writeICML opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- render' :: Doc -> Text
- render' = render colwidth
- renderMeta f s = liftM (render' . fst) $ runStateT (f opts [] s) defaultWriterState
- metadata <- metaToJSON opts
+ renderMeta f s = fst <$> runStateT (f opts [] s) defaultWriterState
+ metadata <- metaToContext opts
(renderMeta blocksToICML)
(renderMeta inlinesToICML)
meta
- (doc, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState
- let main = render' doc
- context = defField "body" main
- $ defField "charStyles" (render' $ charStylesToDoc st)
- $ defField "parStyles" (render' $ parStylesToDoc st)
- $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) metadata
- return $
- (if writerPreferAscii opts then toEntities else id) $
+ (main, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState
+ let context = defField "body" main
+ $ defField "charStyles" (charStylesToDoc st)
+ $ defField "parStyles" (parStylesToDoc st)
+ $ defField "hyperlinks" (hyperlinksToDoc $ links st) metadata
+ return $ render colwidth $
+ (if writerPreferAscii opts then fmap toEntities else id) $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@@ -161,7 +158,7 @@ contains s rule =
[snd rule | (fst rule) `isInfixOf` s]
-- | The monospaced font to use as default.
-monospacedFont :: Doc
+monospacedFont :: Doc Text
monospacedFont = inTags False "AppliedFont" [("type", "string")] $ text "Courier New"
-- | How much to indent blockquotes etc.
@@ -177,7 +174,7 @@ lineSeparator :: String
lineSeparator = "&#x2028;"
-- | Convert a WriterState with its block styles to the ICML listing of Paragraph Styles.
-parStylesToDoc :: WriterState -> Doc
+parStylesToDoc :: WriterState -> Doc Text
parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st
where
makeStyle s =
@@ -243,7 +240,7 @@ parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st
in inTags True "ParagraphStyle" ([("Self", "ParagraphStyle/"++s), ("Name", s)] ++ attrs') props
-- | Convert a WriterState with its inline styles to the ICML listing of Character Styles.
-charStylesToDoc :: WriterState -> Doc
+charStylesToDoc :: WriterState -> Doc Text
charStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ inlineStyles st
where
makeStyle s =
@@ -274,7 +271,7 @@ escapeColons (x:xs)
escapeColons [] = []
-- | Convert a list of (identifier, url) pairs to the ICML listing of hyperlinks.
-hyperlinksToDoc :: Hyperlink -> Doc
+hyperlinksToDoc :: Hyperlink -> Doc Text
hyperlinksToDoc [] = empty
hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs
where
@@ -293,13 +290,13 @@ dynamicStyleKey :: String
dynamicStyleKey = "custom-style"
-- | Convert a list of Pandoc blocks to ICML.
-blocksToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc
+blocksToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML opts style lst = do
docs <- mapM (blockToICML opts style) lst
return $ intersperseBrs docs
-- | Convert a Pandoc block element to ICML.
-blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m Doc
+blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML opts style (Plain lst) = parStyle opts style lst
-- title beginning with fig: indicates that the image is a figure
blockToICML opts style (Para img@[Image _ txt (_,'f':'i':'g':':':_)]) = do
@@ -375,7 +372,7 @@ blockToICML opts style (Div (_, _, kvs) lst) =
blockToICML _ _ Null = return empty
-- | Convert a list of lists of blocks to ICML list items.
-listItemsToICML :: PandocMonad m => WriterOptions -> String -> Style -> Maybe ListAttributes -> [[Block]] -> WS m Doc
+listItemsToICML :: PandocMonad m => WriterOptions -> String -> Style -> Maybe ListAttributes -> [[Block]] -> WS m (Doc Text)
listItemsToICML _ _ _ _ [] = return empty
listItemsToICML opts listType style attribs (first:rest) = do
st <- get
@@ -390,7 +387,7 @@ listItemsToICML opts listType style attribs (first:rest) = do
return $ intersperseBrs docs
-- | Convert a list of blocks to ICML list items.
-listItemToICML :: PandocMonad m => WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS m Doc
+listItemToICML :: PandocMonad m => WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS m (Doc Text)
listItemToICML opts style isFirst attribs item =
let makeNumbStart (Just (beginsWith, numbStl, _)) =
let doN DefaultStyle = []
@@ -416,7 +413,7 @@ listItemToICML opts style isFirst attribs item =
return $ intersperseBrs (f : r)
else blocksToICML opts stl' item
-definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m Doc
+definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m (Doc Text)
definitionListItemToICML opts style (term,defs) = do
term' <- parStyle opts (defListTermName:style) term
defs' <- mapM (blocksToICML opts (defListDefName:style)) defs
@@ -424,11 +421,11 @@ definitionListItemToICML opts style (term,defs) = do
-- | Convert a list of inline elements to ICML.
-inlinesToICML :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m Doc
+inlinesToICML :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m (Doc Text)
inlinesToICML opts style lst = vcat `fmap` mapM (inlineToICML opts style) (mergeStrings opts lst)
-- | Convert an inline element to ICML.
-inlineToICML :: PandocMonad m => WriterOptions -> Style -> Inline -> WS m Doc
+inlineToICML :: PandocMonad m => WriterOptions -> Style -> Inline -> WS m (Doc Text)
inlineToICML _ style (Str str) = charStyle style $ text $ escapeStringForXML str
inlineToICML opts style (Emph lst) = inlinesToICML opts (emphName:style) lst
inlineToICML opts style (Strong lst) = inlinesToICML opts (strongName:style) lst
@@ -451,7 +448,7 @@ inlineToICML opts style SoftBreak =
inlineToICML _ style LineBreak = charStyle style $ text lineSeparator
inlineToICML opts style (Math mt str) =
lift (texMathToInlines mt str) >>=
- (fmap cat . mapM (inlineToICML opts style))
+ (fmap mconcat . mapM (inlineToICML opts style))
inlineToICML _ _ il@(RawInline f str)
| f == Format "icml" = return $ text str
| otherwise = do
@@ -474,7 +471,7 @@ inlineToICML opts style (Span (_, _, kvs) lst) =
in inlinesToICML opts (dynamicStyle <> style) lst
-- | Convert a list of block elements to an ICML footnote.
-footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc
+footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m (Doc Text)
footnoteToICML opts style lst =
let insertTab (Para ls) = blockToICML opts (footnoteName:style) $ Para $ Str "\t":ls
insertTab block = blockToICML opts (footnoteName:style) block
@@ -500,11 +497,11 @@ mergeStrings opts = mergeStrings' . map spaceToStr
mergeStrings' [] = []
-- | Intersperse line breaks
-intersperseBrs :: [Doc] -> Doc
+intersperseBrs :: [Doc Text] -> Doc Text
intersperseBrs = vcat . intersperse (selfClosingTag "Br" []) . filter (not . isEmpty)
-- | Wrap a list of inline elements in an ICML Paragraph Style
-parStyle :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m Doc
+parStyle :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m (Doc Text)
parStyle opts style lst =
let slipIn x y = if null y
then x
@@ -528,7 +525,7 @@ parStyle opts style lst =
state $ \st -> (cont, st{ blockStyles = Set.insert stlStr $ blockStyles st })
-- | Wrap a Doc in an ICML Character Style.
-charStyle :: PandocMonad m => Style -> Doc -> WS m Doc
+charStyle :: PandocMonad m => Style -> Doc Text -> WS m (Doc Text)
charStyle style content =
let (stlStr, attrs) = styleToStrAttr style
doc = inTags True "CharacterStyleRange" attrs $ inTagsSimple "Content" $ flush content
@@ -550,7 +547,7 @@ styleToStrAttr style =
in (stlStr, attrs)
-- | Assemble an ICML Image.
-imageICML :: PandocMonad m => WriterOptions -> Style -> Attr -> Target -> WS m Doc
+imageICML :: PandocMonad m => WriterOptions -> Style -> Attr -> Target -> WS m (Doc Text)
imageICML opts style attr (src, _) = do
imgS <- catchError
(do (img, _) <- P.fetchItem src
diff --git a/src/Text/Pandoc/Writers/Ipynb.hs b/src/Text/Pandoc/Writers/Ipynb.hs
index 4f088f7fc..2d2ee320e 100644
--- a/src/Text/Pandoc/Writers/Ipynb.hs
+++ b/src/Text/Pandoc/Writers/Ipynb.hs
@@ -33,7 +33,7 @@ import qualified Data.Text as T
import Data.Aeson as Aeson
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Shared (safeRead, isURI)
-import Text.Pandoc.Writers.Shared (metaToJSON')
+import Text.Pandoc.Writers.Shared (metaToContext')
import Text.Pandoc.Writers.Markdown (writeMarkdown)
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BL
@@ -73,9 +73,10 @@ pandocToNotebook opts (Pandoc meta blocks) = do
Just z -> (4, z)
Nothing -> (4, 5)
_ -> (4, 5) -- write as v4.5
- metadata' <- metaToJSON' blockWriter inlineWriter $
- B.deleteMeta "nbformat" $
- B.deleteMeta "nbformat_minor" $ jupyterMeta
+ metadata' <- toJSON <$> metaToContext' blockWriter inlineWriter
+ (B.deleteMeta "nbformat" $
+ B.deleteMeta "nbformat_minor" $
+ jupyterMeta)
-- convert from a Value (JSON object) to a M.Map Text Value:
let metadata = case fromJSON metadata' of
Error _ -> mempty -- TODO warning here? shouldn't happen
@@ -109,7 +110,7 @@ extractCells opts (Div (_id,classes,kvs) xs : bs)
source <- writeMarkdown opts{ writerTemplate = Nothing } newdoc
(Cell{
cellType = Markdown
- , cellSource = Source $ breakLines source
+ , cellSource = Source $ breakLines $ T.stripEnd source
, cellMetadata = meta
, cellAttachments = if M.null attachments
then Nothing
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index 23e57663b..ffeceb1c2 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Writers.JATS
@@ -23,6 +24,7 @@ import Data.List (partition, isPrefixOf)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
+import qualified Data.Text as T
import Data.Text (Text)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@@ -31,9 +33,10 @@ import Text.Pandoc.Logging
import Text.Pandoc.MIME (getMimeType)
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
+import Text.DocTemplates (Context(..), Val(..), TemplateTarget(..))
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
@@ -44,7 +47,7 @@ data JATSVersion = JATS1_1
deriving (Eq, Show)
data JATSState = JATSState
- { jatsNotes :: [(Int, Doc)] }
+ { jatsNotes :: [(Int, Doc Text)] }
type JATS a = StateT JATSState (ReaderT JATSVersion a)
@@ -65,54 +68,56 @@ docToJATS opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
-- The numbering here follows LaTeX's internal numbering
let startLvl = case writerTopLevelDivision opts of
TopLevelPart -> -1
TopLevelChapter -> 0
TopLevelSection -> 1
TopLevelDefault -> 1
- metadata <- metaToJSON opts
- (fmap (render' . vcat) .
+ metadata <- metaToContext opts
+ (fmap vcat .
mapM (elementToJATS opts startLvl) .
hierarchicalize)
- (fmap render' . inlinesToJATS opts)
+ (fmap chomp . inlinesToJATS opts)
meta
- main <- (render' . vcat) <$>
- mapM (elementToJATS opts startLvl) elements
+ main <- vcat <$> mapM (elementToJATS opts startLvl) elements
notes <- reverse . map snd <$> gets jatsNotes
backs <- mapM (elementToJATS opts startLvl) backElements
let fns = if null notes
then mempty
else inTagsIndented "fn-group" $ vcat notes
- let back = render' $ vcat backs $$ fns
- let date = case getField "date" metadata -- an object
- `mplus`
- (getField "date" metadata >>= parseDate) of
- Nothing -> mempty
+ let back = vcat backs $$ fns
+ let date =
+ case getField "date" metadata of
+ Nothing -> NullVal
+ Just (SimpleVal (x :: Doc Text)) ->
+ case parseDate (T.unpack $ toText x) of
+ Nothing -> NullVal
Just day ->
let (y,m,d) = toGregorian day
- in M.insert ("year" :: String) (show y)
- $ M.insert "month" (show m)
- $ M.insert "day" (show d)
+ in MapVal $ Context
+ $ M.insert ("year" :: Text) (SimpleVal $ text $ show y)
+ $ M.insert "month" (SimpleVal $ text $ show m)
+ $ M.insert "day" (SimpleVal $ text $ show d)
$ M.insert "iso-8601"
- (formatTime defaultTimeLocale "%F" day)
+ (SimpleVal $ text $
+ formatTime defaultTimeLocale "%F" day)
$ mempty
+ Just x -> x
let context = defField "body" main
$ defField "back" back
- $ resetField ("date" :: String) date
+ $ resetField "date" date
$ defField "mathml" (case writerHTMLMathMethod opts of
MathML -> True
_ -> False) metadata
- return $
- (if writerPreferAscii opts then toEntities else id) $
+ return $ render colwidth $
+ (if writerPreferAscii opts then fmap toEntities else id) $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Convert an Element to JATS.
-elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> JATS m Doc
+elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> JATS m (Doc Text)
elementToJATS opts _ (Blk block) = blockToJATS opts block
elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do
let idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')]
@@ -124,14 +129,14 @@ elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do
inTagsSimple "title" title' $$ vcat contents
-- | Convert a list of Pandoc blocks to JATS.
-blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m Doc
+blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS = wrappedBlocksToJATS (const False)
wrappedBlocksToJATS :: PandocMonad m
=> (Block -> Bool)
-> WriterOptions
-> [Block]
- -> JATS m Doc
+ -> JATS m (Doc Text)
wrappedBlocksToJATS needsWrap opts =
fmap vcat . mapM wrappedBlockToJATS
where
@@ -150,13 +155,13 @@ plainToPara x = x
-- | Convert a list of pairs of terms and definitions into a list of
-- JATS varlistentrys.
deflistItemsToJATS :: PandocMonad m
- => WriterOptions -> [([Inline],[[Block]])] -> JATS m Doc
+ => WriterOptions -> [([Inline],[[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS opts items =
vcat <$> mapM (uncurry (deflistItemToJATS opts)) items
-- | Convert a term and a list of blocks into a JATS varlistentry.
deflistItemToJATS :: PandocMonad m
- => WriterOptions -> [Inline] -> [[Block]] -> JATS m Doc
+ => WriterOptions -> [Inline] -> [[Block]] -> JATS m (Doc Text)
deflistItemToJATS opts term defs = do
term' <- inlinesToJATS opts term
def' <- wrappedBlocksToJATS (not . isPara)
@@ -168,7 +173,7 @@ deflistItemToJATS opts term defs = do
-- | Convert a list of lists of blocks to a list of JATS list items.
listItemsToJATS :: PandocMonad m
- => WriterOptions -> Maybe [String] -> [[Block]] -> JATS m Doc
+ => WriterOptions -> Maybe [String] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS opts markers items =
case markers of
Nothing -> vcat <$> mapM (listItemToJATS opts Nothing) items
@@ -176,7 +181,7 @@ listItemsToJATS opts markers items =
-- | Convert a list of blocks into a JATS list item.
listItemToJATS :: PandocMonad m
- => WriterOptions -> Maybe String -> [Block] -> JATS m Doc
+ => WriterOptions -> Maybe String -> [Block] -> JATS m (Doc Text)
listItemToJATS opts mbmarker item = do
contents <- wrappedBlocksToJATS (not . isParaOrList) opts
(walk demoteHeaderAndRefs item)
@@ -218,7 +223,7 @@ codeAttr (ident,classes,kvs) = (lang, attr)
lang = languageFor classes
-- | Convert a Pandoc block element to JATS.
-blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m Doc
+blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS _ Null = return empty
-- Bibliography reference:
blockToJATS opts (Div ('r':'e':'f':'-':_,_,_) [Para lst]) =
@@ -341,7 +346,7 @@ tableRowToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [[Block]]
- -> JATS m Doc
+ -> JATS m (Doc Text)
tableRowToJATS opts isHeader cols =
(inTagsIndented "tr" . vcat) <$> mapM (tableItemToJATS opts isHeader) cols
@@ -349,7 +354,7 @@ tableItemToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [Block]
- -> JATS m Doc
+ -> JATS m (Doc Text)
tableItemToJATS opts isHeader [Plain item] =
inTags False (if isHeader then "th" else "td") [] <$>
inlinesToJATS opts item
@@ -358,7 +363,7 @@ tableItemToJATS opts isHeader item =
mapM (blockToJATS opts) item
-- | Convert a list of inline elements to JATS.
-inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m Doc
+inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) (fixCitations lst)
where
fixCitations [] = []
@@ -374,7 +379,7 @@ inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) (fixCitations lst)
fixCitations (x:xs) = x : fixCitations xs
-- | Convert an inline element to JATS.
-inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> JATS m Doc
+inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> JATS m (Doc Text)
inlineToJATS _ (Str str) = return $ text $ escapeStringForXML str
inlineToJATS opts (Emph lst) =
inTagsSimple "italic" <$> inlinesToJATS opts lst
diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs
index b0caf82f7..7b41468cc 100644
--- a/src/Text/Pandoc/Writers/Jira.hs
+++ b/src/Text/Pandoc/Writers/Jira.hs
@@ -27,7 +27,7 @@ import Text.Pandoc.Options (WriterOptions (writerTemplate))
import Text.Pandoc.Shared (blocksToInlines, linesToPara)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math (texMathToInlines)
-import Text.Pandoc.Writers.Shared (metaToJSON, defField)
+import Text.Pandoc.Writers.Shared (metaToContext, defField)
import qualified Data.Text as T
data WriterState = WriterState
@@ -53,7 +53,7 @@ writeJira opts document =
pandocToJira :: PandocMonad m
=> WriterOptions -> Pandoc -> JiraWriter m Text
pandocToJira opts (Pandoc meta blocks) = do
- metadata <- metaToJSON opts (blockListToJira opts)
+ metadata <- metaToContext opts (blockListToJira opts)
(inlineListToJira opts) meta
body <- blockListToJira opts blocks
notes <- gets $ T.intercalate "\n" . reverse . stNotes
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 232b0020c..31494baf1 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -21,7 +21,6 @@ import Prelude
import Control.Applicative ((<|>))
import Control.Monad.State.Strict
import Data.Monoid (Any(..))
-import Data.Aeson (object, (.=))
import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isSpace,
isPunctuation, ord, toLower)
import Data.List (foldl', intercalate, intersperse, nubBy,
@@ -39,10 +38,11 @@ import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight,
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Slides
-import Text.Pandoc.Templates
+import Text.Pandoc.Templates (renderTemplate)
+import Text.DocTemplates (Val(..), Context(..))
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
@@ -56,7 +56,7 @@ data WriterState =
, stInMinipage :: Bool -- true if in minipage
, stInHeading :: Bool -- true if in a section heading
, stInItem :: Bool -- true if in \item[..]
- , stNotes :: [Doc] -- notes in a minipage
+ , stNotes :: [Doc Text] -- notes in a minipage
, stOLLevel :: Int -- level of ordered list nesting
, stOptions :: WriterOptions -- writer options, so they don't have to be parameter
, stVerbInNote :: Bool -- true if document has verbatim text in note
@@ -133,11 +133,9 @@ pandocToLaTeX options (Pandoc meta blocks) = do
let colwidth = if writerWrapText options == WrapAuto
then Just $ writerColumns options
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
- metadata <- metaToJSON options
- (fmap render' . blockListToLaTeX)
- (fmap render' . inlineListToLaTeX)
+ metadata <- metaToContext options
+ blockListToLaTeX
+ (fmap chomp . inlineListToLaTeX)
meta
let chaptersClasses = ["memoir","book","report","scrreprt","scrbook","extreport","extbook","tufte-book"]
let frontmatterClasses = ["memoir","book","scrbook","extbook","tufte-book"]
@@ -154,7 +152,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do
_ -> "article"
when (documentClass `elem` chaptersClasses) $
modify $ \s -> s{ stHasChapters = True }
- case T.toLower <$> getField "csquotes" metadata of
+ case T.toLower . render Nothing <$> getField "csquotes" metadata of
Nothing -> return ()
Just "false" -> return ()
Just _ -> modify $ \s -> s{stCsquotes = True}
@@ -167,23 +165,26 @@ pandocToLaTeX options (Pandoc meta blocks) = do
then toSlides blocks''
else return blocks''
body <- mapM (elementToLaTeX options) $ hierarchicalize blocks'''
- (biblioTitle :: Text) <- render' <$> inlineListToLaTeX lastHeader
- let main = render' $ vsep body
+ biblioTitle <- inlineListToLaTeX lastHeader
+ let main = vsep body
st <- get
titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta
authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta
docLangs <- catMaybes <$>
mapM (toLang . Just) (ordNub (query (extract "lang") blocks))
- let hasStringValue x = isJust (getField x metadata :: Maybe String)
- let geometryFromMargins = intercalate [','] $ mapMaybe (\(x,y) ->
- ((x ++ "=") ++) <$> getField y metadata)
+ let hasStringValue x = isJust (getField x metadata :: Maybe (Doc Text))
+ let geometryFromMargins = mconcat $ intersperse ("," :: Doc Text) $
+ mapMaybe (\(x,y) ->
+ ((x <> "=") <>) <$> getField y metadata)
[("lmargin","margin-left")
,("rmargin","margin-right")
,("tmargin","margin-top")
,("bmargin","margin-bottom")
]
- let toPolyObj lang = object [ "name" .= T.pack name
- , "options" .= T.pack opts ]
+ let toPolyObj :: Lang -> Val (Doc Text)
+ toPolyObj lang = MapVal $ Context $
+ M.fromList [ ("name" , SimpleVal $ text name)
+ , ("options" , SimpleVal $ text opts) ]
where
(name, opts) = toPolyglossia lang
mblang <- toLang $ case getLang options meta of
@@ -195,14 +196,16 @@ pandocToLaTeX options (Pandoc meta blocks) = do
let dirs = query (extract "dir") blocks
let context = defField "toc" (writerTableOfContents options) $
- defField "toc-depth" (show (writerTOCDepth options -
+ defField "toc-depth" (T.pack . show $
+ (writerTOCDepth options -
if stHasChapters st
then 1
else 0)) $
defField "body" main $
- defField "title-meta" titleMeta $
- defField "author-meta" (intercalate "; " authorsMeta) $
- defField "documentclass" documentClass $
+ defField "title-meta" (T.pack titleMeta) $
+ defField "author-meta"
+ (T.pack $ intercalate "; " authorsMeta) $
+ defField "documentclass" (T.pack documentClass) $
defField "verbatim-in-note" (stVerbInNote st) $
defField "tables" (stTable st) $
defField "strikeout" (stStrikeout st) $
@@ -218,7 +221,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do
then case writerHighlightStyle options of
Just sty ->
defField "highlighting-macros"
- (styleToLaTeX sty)
+ (T.stripEnd $ styleToLaTeX sty)
Nothing -> id
else id) $
(case writerCiteMethod options of
@@ -232,23 +235,28 @@ pandocToLaTeX options (Pandoc meta blocks) = do
"filecolor"]) $
(if null dirs
then id
- else defField "dir" ("ltr" :: String)) $
+ else defField "dir" ("ltr" :: Text)) $
defField "section-titles" True $
defField "geometry" geometryFromMargins $
- (case getField "papersize" metadata of
+ (case T.unpack . render Nothing <$>
+ getField "papersize" metadata of
-- uppercase a4, a5, etc.
Just (('A':d:ds) :: String)
| all isDigit (d:ds) -> resetField "papersize"
- (('a':d:ds) :: String)
+ (T.pack ('a':d:ds))
_ -> id)
metadata
let context' =
-- note: lang is used in some conditionals in the template,
-- so we need to set it if we have any babel/polyglossia:
- maybe id (defField "lang" . renderLang) mblang
- $ maybe id (defField "babel-lang" . toBabel) mblang
- $ defField "babel-otherlangs" (map toBabel docLangs)
- $ defField "babel-newcommands" (concatMap (\(poly, babel) ->
+ maybe id (\l -> defField "lang"
+ ((text $ renderLang l) :: Doc Text)) mblang
+ $ maybe id (\l -> defField "babel-lang"
+ ((text $ toBabel l) :: Doc Text)) mblang
+ $ defField "babel-otherlangs"
+ (map ((text . toBabel) :: Lang -> Doc Text) docLangs)
+ $ defField "babel-newcommands" (vcat $
+ map (\(poly, babel) -> (text :: String -> Doc Text) $
-- \textspanish and \textgalician are already used by babel
-- save them as \oritext... and let babel use that
if poly `elem` ["spanish", "galician"]
@@ -258,14 +266,14 @@ pandocToLaTeX options (Pandoc meta blocks) = do
++ poly ++ "}}\n" ++
"\\AddBabelHook{" ++ poly ++ "}{afterextras}" ++
"{\\renewcommand{\\text" ++ poly ++ "}[2][]{\\foreignlanguage{"
- ++ poly ++ "}{##2}}}\n"
+ ++ poly ++ "}{##2}}}"
else (if poly == "latin" -- see #4161
then "\\providecommand{\\textlatin}{}\n\\renewcommand"
else "\\newcommand") ++ "{\\text" ++ poly ++
"}[2][]{\\foreignlanguage{" ++ babel ++ "}{#2}}\n" ++
"\\newenvironment{" ++ poly ++
"}[2][]{\\begin{otherlanguage}{" ++
- babel ++ "}}{\\end{otherlanguage}}\n"
+ babel ++ "}}{\\end{otherlanguage}}"
)
-- eliminate duplicates that have same polyglossia name
$ nubBy (\a b -> fst a == fst b)
@@ -273,17 +281,19 @@ pandocToLaTeX options (Pandoc meta blocks) = do
$ map (\l -> (fst $ toPolyglossia l, toBabel l)) docLangs
)
$ maybe id (defField "polyglossia-lang" . toPolyObj) mblang
- $ defField "polyglossia-otherlangs" (map toPolyObj docLangs)
+ $ defField "polyglossia-otherlangs"
+ (ListVal (map toPolyObj docLangs :: [Val (Doc Text)]))
$
defField "latex-dir-rtl"
- (getField "dir" context == Just ("rtl" :: String)) context
- return $
+ ((render Nothing <$> getField "dir" context) ==
+ Just ("rtl" :: Text)) context
+ return $ render colwidth $
case writerTemplate options of
Nothing -> main
Just tpl -> renderTemplate tpl context'
-- | Convert Elements to LaTeX
-elementToLaTeX :: PandocMonad m => WriterOptions -> Element -> LW m Doc
+elementToLaTeX :: PandocMonad m => WriterOptions -> Element -> LW m (Doc Text)
elementToLaTeX _ (Blk block) = blockToLaTeX block
elementToLaTeX opts (Sec level _ (id',classes,_) title' elements) = do
modify $ \s -> s{stInHeading = True}
@@ -435,7 +445,7 @@ toLabel z = go `fmap` stringToLaTeX URLString z
| otherwise = "ux" ++ printf "%x" (ord x) ++ go xs
-- | Puts contents into LaTeX command.
-inCmd :: String -> Doc -> Doc
+inCmd :: String -> Doc Text -> Doc Text
inCmd cmd contents = char '\\' <> text cmd <> braces contents
toSlides :: PandocMonad m => [Block] -> LW m [Block]
@@ -514,7 +524,7 @@ isListBlock _ = False
-- | Convert Pandoc block element to LaTeX.
blockToLaTeX :: PandocMonad m
=> Block -- ^ Block to convert
- -> LW m Doc
+ -> LW m (Doc Text)
blockToLaTeX Null = return empty
blockToLaTeX (Div (identifier,classes,kvs) bs)
| "incremental" `elem` classes = do
@@ -820,7 +830,8 @@ blockToLaTeX (Table caption aligns widths heads rows) = do
$$ captNotes
$$ notes
-getCaption :: PandocMonad m => Bool -> [Inline] -> LW m (Doc, Doc, Doc)
+getCaption :: PandocMonad m
+ => Bool -> [Inline] -> LW m (Doc Text, Doc Text, Doc Text)
getCaption externalNotes txt = do
oldExternalNotes <- gets stExternalNotes
modify $ \st -> st{ stExternalNotes = externalNotes, stNotes = [] }
@@ -846,7 +857,7 @@ toColDescriptor align =
AlignCenter -> "c"
AlignDefault -> "l"
-blockListToLaTeX :: PandocMonad m => [Block] -> LW m Doc
+blockListToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX lst =
vsep `fmap` mapM (\b -> setEmptyLine True >> blockToLaTeX b) lst
@@ -855,7 +866,7 @@ tableRowToLaTeX :: PandocMonad m
-> [Alignment]
-> [Double]
-> [[Block]]
- -> LW m Doc
+ -> LW m (Doc Text)
tableRowToLaTeX header aligns widths cols = do
-- scale factor compensates for extra space between columns
-- so the whole table isn't larger than columnwidth
@@ -897,7 +908,7 @@ displayMathToInline (Math DisplayMath x) = Math InlineMath x
displayMathToInline x = x
tableCellToLaTeX :: PandocMonad m => Bool -> (Double, Alignment, [Block])
- -> LW m Doc
+ -> LW m (Doc Text)
tableCellToLaTeX _ (0, _, blocks) =
blockListToLaTeX $ walk fixLineBreaks $ walk displayMathToInline blocks
tableCellToLaTeX header (width, align, blocks) = do
@@ -922,7 +933,7 @@ tableCellToLaTeX header (width, align, blocks) = do
(halign <> cr <> cellContents <> "\\strut" <> cr) <>
"\\end{minipage}")
-notesToLaTeX :: [Doc] -> Doc
+notesToLaTeX :: [Doc Text] -> Doc Text
notesToLaTeX [] = empty
notesToLaTeX ns = (case length ns of
n | n > 1 -> "\\addtocounter" <>
@@ -935,7 +946,7 @@ notesToLaTeX ns = (case length ns of
$ map (\x -> "\\footnotetext" <> braces x)
$ reverse ns)
-listItemToLaTeX :: PandocMonad m => [Block] -> LW m Doc
+listItemToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text)
listItemToLaTeX lst
-- we need to put some text before a header if it's the first
-- element in an item. This will look ugly in LaTeX regardless, but
@@ -957,7 +968,7 @@ listItemToLaTeX lst
return $ "\\item" <> brackets checkbox
$$ nest 2 (isContents $+$ bsContents)
-defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m Doc
+defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m (Doc Text)
defListItemToLaTeX (term, defs) = do
-- needed to turn off 'listings' because it breaks inside \item[...]:
modify $ \s -> s{stInItem = True}
@@ -985,7 +996,7 @@ sectionHeader :: PandocMonad m
-> [Char]
-> Int
-> [Inline]
- -> LW m Doc
+ -> LW m (Doc Text)
sectionHeader unnumbered ident level lst = do
txt <- inlineListToLaTeX lst
plain <- stringToLaTeX TextString $ concatMap stringify lst
@@ -1002,7 +1013,7 @@ sectionHeader unnumbered ident level lst = do
then return empty
else
return $ brackets txtNoNotes
- let contents = if render Nothing txt == plain
+ let contents = if render Nothing txt == T.pack plain
then braces txt
else braces (text "\\texorpdfstring"
<> braces txt
@@ -1051,7 +1062,7 @@ sectionHeader unnumbered ident level lst = do
braces txtNoNotes
else empty
-hypertarget :: PandocMonad m => Bool -> String -> Doc -> LW m Doc
+hypertarget :: PandocMonad m => Bool -> String -> Doc Text -> LW m (Doc Text)
hypertarget _ "" x = return x
hypertarget addnewline ident x = do
ref <- text `fmap` toLabel ident
@@ -1061,7 +1072,7 @@ hypertarget addnewline ident x = do
then ("%" <> cr)
else empty) <> x)
-labelFor :: PandocMonad m => String -> LW m Doc
+labelFor :: PandocMonad m => String -> LW m (Doc Text)
labelFor "" = return empty
labelFor ident = do
ref <- text `fmap` toLabel ident
@@ -1070,7 +1081,7 @@ labelFor ident = do
-- | Convert list of inline elements to LaTeX.
inlineListToLaTeX :: PandocMonad m
=> [Inline] -- ^ Inlines to convert
- -> LW m Doc
+ -> LW m (Doc Text)
inlineListToLaTeX lst =
mapM inlineToLaTeX (fixLineInitialSpaces . fixInitialLineBreaks $ lst)
>>= return . hcat
@@ -1098,7 +1109,7 @@ isQuoted _ = False
-- | Convert inline element to LaTeX
inlineToLaTeX :: PandocMonad m
=> Inline -- ^ Inline to convert
- -> LW m Doc
+ -> LW m (Doc Text)
inlineToLaTeX (Span (id',classes,kvs) ils) = do
linkAnchor <- hypertarget False id' empty
lang <- toLang $ lookup "lang" kvs
@@ -1293,7 +1304,7 @@ inlineToLaTeX (Image attr _ (source, _)) = do
dimList = showDim Width ++ showDim Height
dims = if null dimList
then empty
- else brackets $ cat (intersperse "," dimList)
+ else brackets $ mconcat (intersperse "," dimList)
source' = if isURI source
then source
else unEscapeString source
@@ -1342,7 +1353,7 @@ protectCode x = [x]
setEmptyLine :: PandocMonad m => Bool -> LW m ()
setEmptyLine b = modify $ \st -> st{ stEmptyLine = b }
-citationsToNatbib :: PandocMonad m => [Citation] -> LW m Doc
+citationsToNatbib :: PandocMonad m => [Citation] -> LW m (Doc Text)
citationsToNatbib
[one]
= citeCommand c p s k
@@ -1393,13 +1404,13 @@ citationsToNatbib cits = do
NormalCitation -> citeCommand "citealp" p s k
citeCommand :: PandocMonad m
- => String -> [Inline] -> [Inline] -> String -> LW m Doc
+ => String -> [Inline] -> [Inline] -> String -> LW m (Doc Text)
citeCommand c p s k = do
args <- citeArguments p s k
return $ text ("\\" ++ c) <> args
citeArguments :: PandocMonad m
- => [Inline] -> [Inline] -> String -> LW m Doc
+ => [Inline] -> [Inline] -> String -> LW m (Doc Text)
citeArguments p s k = do
let s' = case s of
(Str
@@ -1414,7 +1425,7 @@ citeArguments p s k = do
(_ , _ ) -> brackets pdoc <> brackets sdoc
return $ optargs <> braces (text k)
-citationsToBiblatex :: PandocMonad m => [Citation] -> LW m Doc
+citationsToBiblatex :: PandocMonad m => [Citation] -> LW m (Doc Text)
citationsToBiblatex
[one]
= citeCommand cmd p s k
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index cba44ee3a..6bcc2b86f 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -24,10 +24,10 @@ import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Walk (walk)
-import Text.Pandoc.Templates
+import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Writers.Roff
@@ -44,10 +44,8 @@ pandocToMan opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
titleText <- inlineListToMan opts $ docTitle meta
- let title' = render' titleText
+ let title' = render Nothing titleText
let setFieldsFromTitle =
case T.break (== ' ') title' of
(cmdName, rest) -> case T.break (=='(') cmdName of
@@ -62,21 +60,21 @@ pandocToMan opts (Pandoc meta blocks) = do
(T.strip $ mconcat hds)
[] -> id
_ -> defField "title" title'
- metadata <- metaToJSON opts
- (fmap render' . blockListToMan opts)
- (fmap render' . inlineListToMan opts)
+ metadata <- metaToContext opts
+ (blockListToMan opts)
+ (fmap chomp . inlineListToMan opts)
$ deleteMeta "title" meta
body <- blockListToMan opts blocks
notes <- gets stNotes
notes' <- notesToMan opts (reverse notes)
- let main = render' $ body $$ notes' $$ text ""
+ let main = body $$ notes' $$ text ""
hasTables <- gets stHasTables
let context = defField "body" main
$ setFieldsFromTitle
$ defField "has-tables" hasTables
$ defField "hyphenate" True
- $ defField "pandoc-version" pandocVersion metadata
- return $
+ $ defField "pandoc-version" (T.pack pandocVersion) metadata
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@@ -85,7 +83,7 @@ escString :: WriterOptions -> String -> String
escString _ = escapeString AsciiOnly -- for better portability
-- | Return man representation of notes.
-notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState m Doc
+notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text)
notesToMan opts notes =
if null notes
then return empty
@@ -93,7 +91,7 @@ notesToMan opts notes =
return . (text ".SH NOTES" $$) . vcat
-- | Return man representation of a note.
-noteToMan :: PandocMonad m => WriterOptions -> Int -> [Block] -> StateT WriterState m Doc
+noteToMan :: PandocMonad m => WriterOptions -> Int -> [Block] -> StateT WriterState m (Doc Text)
noteToMan opts num note = do
contents <- blockListToMan opts note
let marker = cr <> text ".SS " <> brackets (text (show num))
@@ -107,7 +105,7 @@ noteToMan opts num note = do
blockToMan :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> StateT WriterState m Doc
+ -> StateT WriterState m (Doc Text)
blockToMan _ Null = return empty
blockToMan opts (Div _ bs) = blockListToMan opts bs
blockToMan opts (Plain inlines) =
@@ -187,7 +185,7 @@ blockToMan opts (DefinitionList items) = do
return (vcat contents)
-- | Convert bullet list item (list of blocks) to man.
-bulletListItemToMan :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Doc
+bulletListItemToMan :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToMan _ [] = return empty
bulletListItemToMan opts (Para first:rest) =
bulletListItemToMan opts (Plain first:rest)
@@ -210,7 +208,7 @@ orderedListItemToMan :: PandocMonad m
-> String -- ^ order marker for list item
-> Int -- ^ number of spaces to indent
-> [Block] -- ^ list item (list of blocks)
- -> StateT WriterState m Doc
+ -> StateT WriterState m (Doc Text)
orderedListItemToMan _ _ _ [] = return empty
orderedListItemToMan opts num indent (Para first:rest) =
orderedListItemToMan opts num indent (Plain first:rest)
@@ -228,7 +226,7 @@ orderedListItemToMan opts num indent (first:rest) = do
definitionListItemToMan :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
- -> StateT WriterState m Doc
+ -> StateT WriterState m (Doc Text)
definitionListItemToMan opts (label, defs) = do
-- in most man pages, option and other code in option lists is boldface,
-- but not other things, so we try to reproduce this style:
@@ -260,16 +258,16 @@ makeCodeBold = walk go
blockListToMan :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
- -> StateT WriterState m Doc
+ -> StateT WriterState m (Doc Text)
blockListToMan opts blocks =
vcat <$> mapM (blockToMan opts) blocks
-- | Convert list of Pandoc inline elements to man.
-inlineListToMan :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Doc
+inlineListToMan :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan opts lst = hcat <$> mapM (inlineToMan opts) lst
-- | Convert Pandoc inline element to man.
-inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m Doc
+inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToMan opts (Span _ ils) = inlineListToMan opts ils
inlineToMan opts (Emph lst) =
withFontFeature 'I' (inlineListToMan opts lst)
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 7f30edf1f..e298fafe9 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -20,20 +20,16 @@ module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
import Prelude
import Control.Monad.Reader
import Control.Monad.State.Strict
-import Data.Char (isPunctuation, isSpace, isAlphaNum)
+import Data.Char (isSpace, isAlphaNum)
import Data.Default
-import qualified Data.HashMap.Strict as H
import Data.List (find, group, intersperse, sortBy, stripPrefix, transpose,
isPrefixOf)
import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, catMaybes)
import Data.Ord (comparing)
import qualified Data.Set as Set
-import qualified Data.Scientific as Scientific
import Data.Text (Text)
import qualified Data.Text as T
-import qualified Data.Vector as V
-import Data.Aeson (Value (Array, Bool, Number, Object, String))
import Network.HTTP (urlEncode)
import Text.HTML.TagSoup (Tag (..), isTagText, parseTags)
import Text.Pandoc.Class (PandocMonad, report)
@@ -41,13 +37,14 @@ import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, blanklines, char, space)
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
import Text.Pandoc.Templates (renderTemplate)
+import Text.DocTemplates (Val(..), Context(..), FromContext(..))
import Text.Pandoc.Walk
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Text.Pandoc.Writers.Math (texMathToInlines)
-import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML (toHtml5Entities)
type Notes = [[Block]]
@@ -109,68 +106,82 @@ writePlain :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writePlain opts document =
evalMD (pandocToMarkdown opts document) def{ envPlain = True } def
-pandocTitleBlock :: Doc -> [Doc] -> Doc -> Doc
+pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock tit auths dat =
hang 2 (text "% ") tit <> cr <>
hang 2 (text "% ") (vcat $ map nowrap auths) <> cr <>
hang 2 (text "% ") dat <> cr
-mmdTitleBlock :: Value -> Doc
-mmdTitleBlock (Object hashmap) =
- vcat $ map go $ sortBy (comparing fst) $ H.toList hashmap
+mmdTitleBlock :: Context (Doc Text) -> Doc Text
+mmdTitleBlock (Context hashmap) =
+ vcat $ map go $ sortBy (comparing fst) $ M.toList hashmap
where go (k,v) =
case (text (T.unpack k), v) of
- (k', Array vec)
- | V.null vec -> empty
+ (k', ListVal xs)
+ | null xs -> empty
| otherwise -> k' <> ":" <> space <>
- hcat (intersperse "; "
- (map fromstr $ V.toList vec))
- (_, String "") -> empty
- (k', x) -> k' <> ":" <> space <> nest 2 (fromstr x)
- fromstr (String s) = text (removeBlankLines $ T.unpack s)
- fromstr (Bool b) = text (show b)
- fromstr (Number n) = text (show n)
- fromstr _ = empty
- -- blank lines not allowed in MMD metadata - we replace with .
- removeBlankLines = trimr . unlines . map (\x ->
- if all isSpace x then "." else x) . lines
-mmdTitleBlock _ = empty
+ hcat (intersperse "; " $
+ catMaybes $ map fromVal xs)
+ (k', SimpleVal x)
+ | isEmpty x -> empty
+ | otherwise -> k' <> ":" <> space <>
+ nest 2 (chomp (removeBlankLines x))
+ _ -> empty
+ removeBlankLines BlankLines{} = cr <> text "." <> cr
+ removeBlankLines (Concat x y) = removeBlankLines x <>
+ removeBlankLines y
+ removeBlankLines x = x
-plainTitleBlock :: Doc -> [Doc] -> Doc -> Doc
+plainTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
plainTitleBlock tit auths dat =
tit <> cr <>
(hcat (intersperse (text "; ") auths)) <> cr <>
dat <> cr
-yamlMetadataBlock :: Value -> Doc
-yamlMetadataBlock v = "---" $$ (jsonToYaml v) $$ "---"
+yamlMetadataBlock :: Context (Doc Text) -> Doc Text
+yamlMetadataBlock v = "---" $$ (contextToYaml v) $$ "---"
+
+contextToYaml :: Context (Doc Text) -> Doc Text
+contextToYaml (Context o) =
+ vcat $ map keyvalToYaml $ sortBy (comparing fst) $ M.toList o
+ where
+ keyvalToYaml (k,v) =
+ case (text (T.unpack k), v) of
+ (k', ListVal vs)
+ | null vs -> empty
+ | otherwise -> (k' <> ":") $$ valToYaml v
+ (k', MapVal (Context m))
+ | M.null m -> k' <> ": {}"
+ | otherwise -> (k' <> ":") $$ nest 2 (valToYaml v)
+ (_, SimpleVal x)
+ | isEmpty x -> empty
+ (_, NullVal) -> empty
+ (k', _) -> k' <> ":" <+> hang 2 "" (valToYaml v)
-jsonToYaml :: Value -> Doc
-jsonToYaml (Object hashmap) =
- vcat $ map (\(k,v) ->
- case (text (T.unpack k), v, jsonToYaml v) of
- (k', Array vec, x)
- | V.null vec -> empty
- | otherwise -> (k' <> ":") $$ x
- (k', Object hm, x)
- | H.null hm -> k' <> ": {}"
- | otherwise -> (k' <> ":") $$ nest 2 x
- (_, String "", _) -> empty
- (k', _, x) -> k' <> ":" <> space <> hang 2 "" x)
- $ sortBy (comparing fst) $ H.toList hashmap
-jsonToYaml (Array vec) =
- vcat $ map (\v -> hang 2 "- " (jsonToYaml v)) $ V.toList vec
-jsonToYaml (String "") = empty
-jsonToYaml (String s) =
- case T.unpack s of
- x | '\n' `elem` x -> hang 2 ("|" <> cr) $ text x
- | not (any isPunctuation x) -> text x
- | otherwise -> text $ "'" ++ substitute "'" "''" x ++ "'"
-jsonToYaml (Bool b) = text $ show b
-jsonToYaml (Number n)
- | Scientific.isInteger n = text $ show (floor n :: Integer)
- | otherwise = text $ show n
-jsonToYaml _ = empty
+valToYaml :: Val (Doc Text) -> Doc Text
+valToYaml (ListVal xs) =
+ vcat $ map (\v -> hang 2 "- " (valToYaml v)) xs
+valToYaml (MapVal c) = contextToYaml c
+valToYaml (SimpleVal x)
+ | isEmpty x = empty
+ | otherwise =
+ if hasNewlines x
+ then hang 0 ("|" <> cr) x
+ else if any hasPunct x
+ then "'" <> fmap escapeSingleQuotes x <> "'"
+ else x
+ where
+ hasNewlines NewLine = True
+ hasNewlines BlankLines{} = True
+ hasNewlines CarriageReturn = True
+ hasNewlines (Concat w z) = hasNewlines w || hasNewlines z
+ hasNewlines _ = False
+ hasPunct = T.any isYamlPunct
+ isYamlPunct = (`elem` ['-','?',':',',','[',']','{','}',
+ '#','&','*','!','|','>','\'','"',
+ '%','@','`',',','[',']','{','}'])
+ escapeSingleQuotes = T.replace "'" "''"
+valToYaml _ = empty
-- | Return markdown representation of document.
pandocToMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> MD m Text
@@ -179,15 +190,13 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
then Just $ writerColumns opts
else Nothing
isPlain <- asks envPlain
- let render' :: Doc -> Text
- render' = render colwidth . chomp
- metadata <- metaToJSON'
- (fmap render' . blockListToMarkdown opts)
- (fmap render' . blockToMarkdown opts . Plain)
+ metadata <- metaToContext'
+ (blockListToMarkdown opts)
+ (inlineListToMarkdown opts)
meta
- let title' = maybe empty text $ getField "title" metadata
- let authors' = maybe [] (map text) $ getField "author" metadata
- let date' = maybe empty text $ getField "date" metadata
+ let title' = maybe empty id $ getField "title" metadata
+ let authors' = maybe [] id $ getField "author" metadata
+ let date' = maybe empty id $ getField "date" metadata
let titleblock = case writerTemplate opts of
Just _ | isPlain ->
plainTitleBlock title' authors' date'
@@ -201,9 +210,8 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
Nothing -> empty
let headerBlocks = filter isHeaderBlock blocks
toc <- if writerTableOfContents opts
- then render' <$> blockToMarkdown opts
- ( toTableOfContents opts headerBlocks )
- else return ""
+ then blockToMarkdown opts ( toTableOfContents opts headerBlocks )
+ else return mempty
-- Strip off final 'references' header if markdown citations enabled
let blocks' = if isEnabled Ext_citations opts
then case reverse blocks of
@@ -212,7 +220,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
else blocks
body <- blockListToMarkdown opts blocks'
notesAndRefs' <- notesAndRefs opts
- let main = render' $ body <> notesAndRefs'
+ let main = body <> notesAndRefs'
let context = -- for backwards compatibility we populate toc
-- with the contents of the toc, rather than a
-- boolean:
@@ -221,22 +229,22 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
$ defField "body" main
$ (if isNullMeta meta
then id
- else defField "titleblock" (render' titleblock))
- $ addVariablesToJSON opts metadata
- return $
+ else defField "titleblock" titleblock)
+ $ addVariablesToContext opts metadata
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Return markdown representation of reference key table.
-refsToMarkdown :: PandocMonad m => WriterOptions -> Refs -> MD m Doc
+refsToMarkdown :: PandocMonad m => WriterOptions -> Refs -> MD m (Doc Text)
refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
-- | Return markdown representation of a reference key.
keyToMarkdown :: PandocMonad m
=> WriterOptions
-> Ref
- -> MD m Doc
+ -> MD m (Doc Text)
keyToMarkdown opts (label', (src, tit), attr) = do
let tit' = if null tit
then empty
@@ -246,7 +254,7 @@ keyToMarkdown opts (label', (src, tit), attr) = do
<+> linkAttributes opts attr
-- | Return markdown representation of notes.
-notesToMarkdown :: PandocMonad m => WriterOptions -> [[Block]] -> MD m Doc
+notesToMarkdown :: PandocMonad m => WriterOptions -> [[Block]] -> MD m (Doc Text)
notesToMarkdown opts notes = do
n <- gets stNoteNum
notes' <- mapM (\(num, note) -> noteToMarkdown opts num note) (zip [n..] notes)
@@ -254,7 +262,7 @@ notesToMarkdown opts notes = do
return $ vsep notes'
-- | Return markdown representation of a note.
-noteToMarkdown :: PandocMonad m => WriterOptions -> Int -> [Block] -> MD m Doc
+noteToMarkdown :: PandocMonad m => WriterOptions -> Int -> [Block] -> MD m (Doc Text)
noteToMarkdown opts num blocks = do
contents <- blockListToMarkdown opts blocks
let num' = text $ writerIdentifierPrefix opts ++ show num
@@ -310,7 +318,7 @@ escapeString opts =
_ -> '.':go cs
_ -> c : go cs
-attrsToMarkdown :: Attr -> Doc
+attrsToMarkdown :: Attr -> Doc Text
attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]
where attribId = case attribs of
([],_,_) -> empty
@@ -331,7 +339,7 @@ attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]
escAttrChar '\\' = text "\\\\"
escAttrChar c = text [c]
-linkAttributes :: WriterOptions -> Attr -> Doc
+linkAttributes :: WriterOptions -> Attr -> Doc Text
linkAttributes opts attr =
if isEnabled Ext_link_attributes opts && attr /= nullAttr
then attrsToMarkdown attr
@@ -353,7 +361,7 @@ beginsWithOrderedListMarker str =
Left _ -> False
Right _ -> True
-notesAndRefs :: PandocMonad m => WriterOptions -> MD m Doc
+notesAndRefs :: PandocMonad m => WriterOptions -> MD m (Doc Text)
notesAndRefs opts = do
notes' <- reverse <$> gets stNotes >>= notesToMarkdown opts
modify $ \s -> s { stNotes = [] }
@@ -375,7 +383,7 @@ notesAndRefs opts = do
blockToMarkdown :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> MD m Doc
+ -> MD m (Doc Text)
blockToMarkdown opts blk =
local (\env -> env {envBlockLevel = envBlockLevel env + 1}) $
do doc <- blockToMarkdown' opts blk
@@ -387,7 +395,7 @@ blockToMarkdown opts blk =
blockToMarkdown' :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> MD m Doc
+ -> MD m (Doc Text)
blockToMarkdown' _ Null = return empty
blockToMarkdown' opts (Div attrs ils) = do
contents <- blockListToMarkdown opts ils
@@ -417,7 +425,7 @@ blockToMarkdown' opts (Plain inlines) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let rendered = render colwidth contents
+ let rendered = T.unpack $ render colwidth contents
let escapeMarker (x:xs) | x `elem` (".()" :: String) = '\\':x:xs
| otherwise = x : escapeMarker xs
escapeMarker [] = []
@@ -624,10 +632,10 @@ blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do
rows
(id,) <$> pipeTable (all null headers) aligns' rawHeaders rawRows
| otherwise -> return $ (id, text "[TABLE]")
- return $ nst $ tbl $$ caption'' $$ blankline
+ return $ nst (tbl $$ caption'') $$ blankline
blockToMarkdown' opts (BulletList items) = do
contents <- inList $ mapM (bulletListItemToMarkdown opts) items
- return $ cat contents <> blankline
+ return $ (if isTightList items then vcat else vsep) contents <> blankline
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
@@ -640,10 +648,10 @@ blockToMarkdown' opts (OrderedList (start,sty,delim) items) = do
contents <- inList $
mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $
zip markers' items
- return $ cat contents <> blankline
+ return $ (if isTightList items then vcat else vsep) contents <> blankline
blockToMarkdown' opts (DefinitionList items) = do
contents <- inList $ mapM (definitionListItemToMarkdown opts) items
- return $ cat contents <> blankline
+ return $ mconcat contents <> blankline
inList :: Monad m => MD m a -> MD m a
inList p = local (\env -> env {envInList = True}) p
@@ -657,7 +665,9 @@ addMarkdownAttribute s =
x /= "markdown"]
_ -> s
-pipeTable :: PandocMonad m => Bool -> [Alignment] -> [Doc] -> [[Doc]] -> MD m Doc
+pipeTable :: PandocMonad m
+ => Bool -> [Alignment] -> [Doc Text] -> [[Doc Text]]
+ -> MD m (Doc Text)
pipeTable headless aligns rawHeaders rawRows = do
let sp = text " "
let blockFor AlignLeft x y = lblock (x + 2) (sp <> y) <> lblock 0 empty
@@ -687,7 +697,7 @@ pipeTable headless aligns rawHeaders rawRows = do
pandocTable :: PandocMonad m
=> WriterOptions -> Bool -> Bool -> [Alignment] -> [Double]
- -> [Doc] -> [[Doc]] -> MD m Doc
+ -> [Doc Text] -> [[Doc Text]] -> MD m (Doc Text)
pandocTable opts multiline headless aligns widths rawHeaders rawRows = do
let isSimple = all (==0) widths
let alignHeader alignment = case alignment of
@@ -717,7 +727,7 @@ pandocTable opts multiline headless aligns widths rawHeaders rawRows = do
(zipWith3 alignHeader aligns widthsInChars)
let rows' = map makeRow rawRows
let head' = makeRow rawHeaders
- let underline = cat $ intersperse (text " ") $
+ let underline = mconcat $ intersperse (text " ") $
map (\width -> text (replicate width '-')) widthsInChars
let border = if multiline
then text (replicate (sum widthsInChars +
@@ -747,7 +757,7 @@ itemEndsWithTightList bs =
_ -> False
-- | Convert bullet list item (list of blocks) to markdown.
-bulletListItemToMarkdown :: PandocMonad m => WriterOptions -> [Block] -> MD m Doc
+bulletListItemToMarkdown :: PandocMonad m => WriterOptions -> [Block] -> MD m (Doc Text)
bulletListItemToMarkdown opts bs = do
let exts = writerExtensions opts
contents <- blockListToMarkdown opts $ taskListItemToAscii exts bs
@@ -757,14 +767,14 @@ bulletListItemToMarkdown opts bs = do
let contents' = if itemEndsWithTightList bs
then chomp contents <> cr
else contents
- return $ hang (writerTabStop opts) start $ contents' <> cr
+ return $ hang (writerTabStop opts) start $ contents'
-- | Convert ordered list item (a list of blocks) to markdown.
orderedListItemToMarkdown :: PandocMonad m
=> WriterOptions -- ^ options
-> String -- ^ list item marker
-> [Block] -- ^ list item (list of blocks)
- -> MD m Doc
+ -> MD m (Doc Text)
orderedListItemToMarkdown opts marker bs = do
let exts = writerExtensions opts
contents <- blockListToMarkdown opts $ taskListItemToAscii exts bs
@@ -779,13 +789,13 @@ orderedListItemToMarkdown opts marker bs = do
let contents' = if itemEndsWithTightList bs
then chomp contents <> cr
else contents
- return $ hang ind start $ contents' <> cr
+ return $ hang ind start $ contents'
-- | Convert definition list item (label, list of blocks) to markdown.
definitionListItemToMarkdown :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
- -> MD m Doc
+ -> MD m (Doc Text)
definitionListItemToMarkdown opts (label, defs) = do
labelText <- blockToMarkdown opts (Plain label)
defs' <- mapM (mapM (blockToMarkdown opts)) defs
@@ -797,17 +807,18 @@ definitionListItemToMarkdown opts (label, defs) = do
let sps = case writerTabStop opts - 3 of
n | n > 0 -> text $ replicate n ' '
_ -> text " "
+ let isTight = case defs of
+ ((Plain _ : _): _) -> True
+ _ -> False
if isEnabled Ext_compact_definition_lists opts
then do
let contents = vcat $ map (\d -> hang tabStop (leader <> sps)
$ vcat d <> cr) defs'
return $ nowrap labelText <> cr <> contents <> cr
else do
- let contents = vcat $ map (\d -> hang tabStop (leader <> sps)
- $ vcat d <> cr) defs'
- let isTight = case defs of
- ((Plain _ : _): _) -> True
- _ -> False
+ let contents = (if isTight then vcat else vsep) $ map
+ (\d -> hang tabStop (leader <> sps) $ vcat d)
+ defs'
return $ blankline <> nowrap labelText $$
(if isTight then empty else blankline) <> contents <> blankline
else do
@@ -818,7 +829,7 @@ definitionListItemToMarkdown opts (label, defs) = do
blockListToMarkdown :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
- -> MD m Doc
+ -> MD m (Doc Text)
blockListToMarkdown opts blocks = do
inlist <- asks envInList
isPlain <- asks envPlain
@@ -860,10 +871,10 @@ blockListToMarkdown opts blocks = do
else if isEnabled Ext_raw_html opts
then RawBlock "html" "<!-- -->\n"
else RawBlock "markdown" "&nbsp;\n"
- mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat
+ mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . mconcat
-getKey :: Doc -> Key
-getKey = toKey . render Nothing
+getKey :: Doc Text -> Key
+getKey = toKey . T.unpack . render Nothing
findUsableIndex :: [String] -> Int -> Int
findUsableIndex lbls i = if (show i) `elem` lbls
@@ -880,7 +891,7 @@ getNextIndex = do
-- | Get reference for target; if none exists, create unique one and return.
-- Prefer label if possible; otherwise, generate a unique key.
-getReference :: PandocMonad m => Attr -> Doc -> Target -> MD m String
+getReference :: PandocMonad m => Attr -> Doc Text -> Target -> MD m String
getReference attr label target = do
refs <- gets stRefs
case find (\(_,t,a) -> t == target && a == attr) refs of
@@ -894,7 +905,8 @@ getReference attr label target = do
i <- getNextIndex
modify $ \s -> s{ stLastIdx = i }
return (show i, i)
- else return (render Nothing label, 0)
+ else
+ return (T.unpack (render Nothing label), 0)
modify (\s -> s{
stRefs = (lab', target, attr) : refs,
stKeys = M.insert (getKey label)
@@ -905,7 +917,7 @@ getReference attr label target = do
Just km -> do -- we have refs with this label
case M.lookup (target, attr) km of
Just i -> do
- let lab' = render Nothing $
+ let lab' = T.unpack $ render Nothing $
label <> if i == 0
then mempty
else text (show i)
@@ -928,7 +940,7 @@ getReference attr label target = do
return lab'
-- | Convert list of Pandoc inline elements to markdown.
-inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m Doc
+inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown opts lst = do
inlist <- asks envInList
go (if inlist then avoidBadWrapsInList lst else lst)
@@ -998,7 +1010,7 @@ isRight (Right _) = True
isRight (Left _) = False
-- | Convert Pandoc inline element to markdown.
-inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m Doc
+inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown opts (Span ("",["emoji"],kvs) [Str s]) = do
case lookup "data-emoji" kvs of
Just emojiname | isEnabled Ext_emoji opts ->
@@ -1051,7 +1063,7 @@ inlineToMarkdown opts (Superscript lst) =
else if isEnabled Ext_raw_html opts
then "<sup>" <> contents <> "</sup>"
else
- let rendered = render Nothing contents
+ let rendered = T.unpack $ render Nothing contents
in case mapM toSuperscript rendered of
Just r -> text r
Nothing -> text $ "^(" ++ rendered ++ ")"
@@ -1064,7 +1076,7 @@ inlineToMarkdown opts (Subscript lst) =
else if isEnabled Ext_raw_html opts
then "<sub>" <> contents <> "</sub>"
else
- let rendered = render Nothing contents
+ let rendered = T.unpack $ render Nothing contents
in case mapM toSubscript rendered of
Just r -> text r
Nothing -> text $ "_(" ++ rendered ++ ")"
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index 5fed75037..c60624d25 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -24,7 +24,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty (render)
+import Text.DocLayout (render)
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@@ -54,9 +54,9 @@ writeMediaWiki opts document =
pandocToMediaWiki :: PandocMonad m => Pandoc -> MediaWikiWriter m Text
pandocToMediaWiki (Pandoc meta blocks) = do
opts <- asks options
- metadata <- metaToJSON opts
+ metadata <- metaToContext opts
(fmap trimr . blockListToMediaWiki)
- inlineListToMediaWiki
+ (fmap trimr . inlineListToMediaWiki)
meta
body <- blockListToMediaWiki blocks
notesExist <- gets stNotes
@@ -66,9 +66,9 @@ pandocToMediaWiki (Pandoc meta blocks) = do
let main = body ++ notes
let context = defField "body" main
$ defField "toc" (writerTableOfContents opts) metadata
- return $
+ return $ pack $
case writerTemplate opts of
- Nothing -> pack main
+ Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Escape special characters for MediaWiki.
diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs
index 204fac7c6..634255604 100644
--- a/src/Text/Pandoc/Writers/Ms.hs
+++ b/src/Text/Pandoc/Writers/Ms.hs
@@ -37,9 +37,9 @@ import Text.Pandoc.Highlighting
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
-import Text.Pandoc.Templates
+import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Writers.Roff
@@ -57,14 +57,11 @@ pandocToMs opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
- metadata <- metaToJSON opts
- (fmap render' . blockListToMs opts)
- (fmap render' . inlineListToMs' opts)
+ metadata <- metaToContext opts
+ (blockListToMs opts)
+ (fmap chomp . inlineListToMs' opts)
meta
- body <- blockListToMs opts blocks
- let main = render' body
+ main <- blockListToMs opts blocks
hasInlineMath <- gets stHasInlineMath
let titleMeta = (escapeStr opts . stringify) $ docTitle meta
let authorsMeta = map (escapeStr opts . stringify) $ docAuthors meta
@@ -72,18 +69,18 @@ pandocToMs opts (Pandoc meta blocks) = do
let highlightingMacros = if hasHighlighting
then case writerHighlightStyle opts of
Nothing -> mempty
- Just sty -> render' $ styleToMs sty
+ Just sty -> styleToMs sty
else mempty
let context = defField "body" main
$ defField "has-inline-math" hasInlineMath
$ defField "hyphenate" True
- $ defField "pandoc-version" pandocVersion
+ $ defField "pandoc-version" (T.pack pandocVersion)
$ defField "toc" (writerTableOfContents opts)
- $ defField "title-meta" titleMeta
- $ defField "author-meta" (intercalate "; " authorsMeta)
+ $ defField "title-meta" (T.pack titleMeta)
+ $ defField "author-meta" (T.pack $ intercalate "; " authorsMeta)
$ defField "highlighting-macros" highlightingMacros metadata
- return $
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@@ -112,7 +109,7 @@ toSmallCaps opts (c:cs)
blockToMs :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> MS m Doc
+ -> MS m (Doc Text)
blockToMs _ Null = return empty
blockToMs opts (Div (ident,_,_) bs) = do
let anchor = if null ident
@@ -264,7 +261,7 @@ blockToMs opts (DefinitionList items) = do
return (vcat contents)
-- | Convert bullet list item (list of blocks) to ms.
-bulletListItemToMs :: PandocMonad m => WriterOptions -> [Block] -> MS m Doc
+bulletListItemToMs :: PandocMonad m => WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs _ [] = return empty
bulletListItemToMs opts (Para first:rest) =
bulletListItemToMs opts (Plain first:rest)
@@ -287,7 +284,7 @@ orderedListItemToMs :: PandocMonad m
-> String -- ^ order marker for list item
-> Int -- ^ number of spaces to indent
-> [Block] -- ^ list item (list of blocks)
- -> MS m Doc
+ -> MS m (Doc Text)
orderedListItemToMs _ _ _ [] = return empty
orderedListItemToMs opts num indent (Para first:rest) =
orderedListItemToMs opts num indent (Plain first:rest)
@@ -306,7 +303,7 @@ orderedListItemToMs opts num indent (first:rest) = do
definitionListItemToMs :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
- -> MS m Doc
+ -> MS m (Doc Text)
definitionListItemToMs opts (label, defs) = do
labelText <- inlineListToMs' opts $ map breakToSpace label
contents <- if null defs
@@ -327,26 +324,26 @@ definitionListItemToMs opts (label, defs) = do
blockListToMs :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
- -> MS m Doc
+ -> MS m (Doc Text)
blockListToMs opts blocks =
vcat <$> mapM (blockToMs opts) blocks
-- | Convert list of Pandoc inline elements to ms.
-inlineListToMs :: PandocMonad m => WriterOptions -> [Inline] -> MS m Doc
+inlineListToMs :: PandocMonad m => WriterOptions -> [Inline] -> MS m (Doc Text)
-- if list starts with ., insert a zero-width character \& so it
-- won't be interpreted as markup if it falls at the beginning of a line.
inlineListToMs opts lst = hcat <$> mapM (inlineToMs opts) lst
-- This version to be used when there is no further inline content;
-- forces a note at the end.
-inlineListToMs' :: PandocMonad m => WriterOptions -> [Inline] -> MS m Doc
+inlineListToMs' :: PandocMonad m => WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' opts lst = do
x <- hcat <$> mapM (inlineToMs opts) lst
y <- handleNotes opts empty
return $ x <> y
-- | Convert Pandoc inline element to ms.
-inlineToMs :: PandocMonad m => WriterOptions -> Inline -> MS m Doc
+inlineToMs :: PandocMonad m => WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs opts (Span _ ils) = inlineListToMs opts ils
inlineToMs opts (Emph lst) =
withFontFeature 'I' (inlineListToMs opts lst)
@@ -382,7 +379,7 @@ inlineToMs opts (Code attr str) = do
withFontFeature 'C' (return hlCode)
inlineToMs opts (Str str) = do
let shim = case str of
- '.':_ -> afterBreak "\\&"
+ '.':_ -> afterBreak (T.pack "\\&")
_ -> empty
smallcaps <- gets stSmallCaps
if smallcaps
@@ -437,7 +434,7 @@ inlineToMs _ (Note contents) = do
modify $ \st -> st{ stNotes = contents : stNotes st }
return $ text "\\**"
-handleNotes :: PandocMonad m => WriterOptions -> Doc -> MS m Doc
+handleNotes :: PandocMonad m => WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes opts fallback = do
notes <- gets stNotes
if null notes
@@ -446,7 +443,7 @@ handleNotes opts fallback = do
modify $ \st -> st{ stNotes = [] }
vcat <$> mapM (handleNote opts) notes
-handleNote :: PandocMonad m => WriterOptions -> Note -> MS m Doc
+handleNote :: PandocMonad m => WriterOptions -> Note -> MS m (Doc Text)
handleNote opts bs = do
-- don't start with Paragraph or we'll get a spurious blank
-- line after the note ref:
@@ -469,7 +466,7 @@ breakToSpace x = x
-- Highlighting
-styleToMs :: Style -> Doc
+styleToMs :: Style -> Doc Text
styleToMs sty = vcat $ colordefs ++ map (toMacro sty) alltoktypes
where alltoktypes = enumFromTo KeywordTok NormalTok
colordefs = map toColorDef allcolors
@@ -484,7 +481,7 @@ styleToMs sty = vcat $ colordefs ++ map (toMacro sty) alltoktypes
hexColor :: Color -> String
hexColor (RGB r g b) = printf "%02x%02x%02x" r g b
-toMacro :: Style -> TokenType -> Doc
+toMacro :: Style -> TokenType -> Doc Text
toMacro sty toktype =
nowrap (text ".ds " <> text (show toktype) <> text " " <>
setbg <> setcolor <> setfont <>
@@ -512,7 +509,7 @@ toMacro sty toktype =
-- lnColor = lineNumberColor sty
-- lnBkgColor = lineNumberBackgroundColor sty
-msFormatter :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc
+msFormatter :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
msFormatter opts _fmtopts =
vcat . map fmtLine
where fmtLine = hcat . map fmtToken
@@ -520,7 +517,7 @@ msFormatter opts _fmtopts =
brackets (text (show toktype) <> text " \""
<> text (escapeStr opts (T.unpack tok)) <> text "\"")
-highlightCode :: PandocMonad m => WriterOptions -> Attr -> String -> MS m Doc
+highlightCode :: PandocMonad m => WriterOptions -> Attr -> String -> MS m (Doc Text)
highlightCode opts attr str =
case highlight (writerSyntaxMap opts) (msFormatter opts) attr str of
Left msg -> do
diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index 1fd68fa8f..8c0410a56 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -32,13 +32,14 @@ import Data.Char (isAlphaNum, isAsciiLower, isAsciiUpper, isDigit, isSpace)
import Data.Default
import Data.List (intersperse, isInfixOf, transpose)
import qualified Data.Set as Set
+import qualified Data.Text as T
import Data.Text (Text)
import System.FilePath (takeExtension)
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math
@@ -104,17 +105,15 @@ pandocToMuse (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let render' :: Doc -> Text
- render' = render Nothing
- metadata <- metaToJSON opts
- (fmap render' . blockListToMuse)
- (fmap render' . inlineListToMuse)
+ metadata <- metaToContext opts
+ blockListToMuse
+ (fmap chomp . inlineListToMuse)
meta
body <- blockListToMuse blocks
notes <- currentNotesToMuse
- let main = render colwidth $ body $+$ notes
+ let main = body $+$ notes
let context = defField "body" main metadata
- return $
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@@ -124,7 +123,7 @@ pandocToMuse (Pandoc meta blocks) = do
catWithBlankLines :: PandocMonad m
=> [Block] -- ^ List of block elements
-> Int -- ^ Number of blank lines
- -> Muse m Doc
+ -> Muse m (Doc Text)
catWithBlankLines (b : bs) n = do
b' <- blockToMuseWithNotes b
bs' <- flatBlockListToMuse bs
@@ -135,7 +134,7 @@ catWithBlankLines _ _ = error "Expected at least one block"
-- | without setting envTopLevel.
flatBlockListToMuse :: PandocMonad m
=> [Block] -- ^ List of block elements
- -> Muse m Doc
+ -> Muse m (Doc Text)
flatBlockListToMuse bs@(BulletList _ : BulletList _ : _) = catWithBlankLines bs 2
flatBlockListToMuse bs@(OrderedList (_, style1, _) _ : OrderedList (_, style2, _) _ : _) =
catWithBlankLines bs (if style1' == style2' then 2 else 0)
@@ -152,7 +151,7 @@ simpleTable :: PandocMonad m
=> [Inline]
-> [TableCell]
-> [[TableCell]]
- -> Muse m Doc
+ -> Muse m (Doc Text)
simpleTable caption headers rows = do
topLevel <- asks envTopLevel
caption' <- inlineListToMuse caption
@@ -175,7 +174,7 @@ simpleTable caption headers rows = do
-- | Convert list of Pandoc block elements to Muse.
blockListToMuse :: PandocMonad m
=> [Block] -- ^ List of block elements
- -> Muse m Doc
+ -> Muse m (Doc Text)
blockListToMuse =
local (\env -> env { envTopLevel = not (envInsideBlock env)
, envInsideBlock = True
@@ -184,7 +183,7 @@ blockListToMuse =
-- | Convert Pandoc block element to Muse.
blockToMuse :: PandocMonad m
=> Block -- ^ Block element
- -> Muse m Doc
+ -> Muse m (Doc Text)
blockToMuse (Plain inlines) = inlineListToMuse' inlines
blockToMuse (Para inlines) = do
contents <- inlineListToMuse' inlines
@@ -213,7 +212,7 @@ blockToMuse (OrderedList (start, style, _) items) = do
where orderedListItemToMuse :: PandocMonad m
=> String -- ^ marker for list item
-> [Block] -- ^ list item (list of blocks)
- -> Muse m Doc
+ -> Muse m (Doc Text)
orderedListItemToMuse marker item = hang (length marker + 1) (text marker <> space)
<$> blockListToMuse item
blockToMuse (BulletList items) = do
@@ -222,7 +221,7 @@ blockToMuse (BulletList items) = do
return $ (if topLevel then nest 1 else id) (vcat contents) $$ blankline
where bulletListItemToMuse :: PandocMonad m
=> [Block]
- -> Muse m Doc
+ -> Muse m (Doc Text)
bulletListItemToMuse item = do
modify $ \st -> st { stUseTags = False }
hang 2 "- " <$> blockListToMuse item
@@ -232,16 +231,17 @@ blockToMuse (DefinitionList items) = do
return $ (if topLevel then nest 1 else id) (vcat contents) $$ blankline
where definitionListItemToMuse :: PandocMonad m
=> ([Inline], [[Block]])
- -> Muse m Doc
+ -> Muse m (Doc Text)
definitionListItemToMuse (label, defs) = do
modify $ \st -> st { stUseTags = False }
label' <- local (\env -> env { envOneLine = True, envAfterSpace = True }) $ inlineListToMuse' label
- let ind = offset' label' -- using Text.Pandoc.Pretty.offset results in round trip failures
+ let ind = offset' label' -- using Text.DocLayout.offset results in round trip failures
hang ind (nowrap label') . vcat <$> mapM descriptionToMuse defs
- where offset' d = maximum (0: map length (lines $ render Nothing d))
+ where offset' d = maximum (0: map T.length
+ (T.lines $ render Nothing d))
descriptionToMuse :: PandocMonad m
=> [Block]
- -> Muse m Doc
+ -> Muse m (Doc Text)
descriptionToMuse desc = hang 4 " :: " <$> blockListToMuse desc
blockToMuse (Header level (ident,_,_) inlines) = do
opts <- asks envOptions
@@ -274,7 +274,7 @@ blockToMuse Null = return empty
-- | Return Muse representation of notes collected so far.
currentNotesToMuse :: PandocMonad m
- => Muse m Doc
+ => Muse m (Doc Text)
currentNotesToMuse = do
notes <- reverse <$> gets stNotes
modify $ \st -> st { stNotes = mempty }
@@ -283,7 +283,7 @@ currentNotesToMuse = do
-- | Return Muse representation of notes.
notesToMuse :: PandocMonad m
=> Notes
- -> Muse m Doc
+ -> Muse m (Doc Text)
notesToMuse notes = do
n <- gets stNoteNum
modify $ \st -> st { stNoteNum = stNoteNum st + length notes }
@@ -293,7 +293,7 @@ notesToMuse notes = do
noteToMuse :: PandocMonad m
=> Int
-> [Block]
- -> Muse m Doc
+ -> Muse m (Doc Text)
noteToMuse num note = do
res <- hang (length marker) (text marker) <$>
local (\env -> env { envInsideBlock = True
@@ -307,7 +307,7 @@ noteToMuse num note = do
-- | Return Muse representation of block and accumulated notes.
blockToMuseWithNotes :: PandocMonad m
=> Block
- -> Muse m Doc
+ -> Muse m (Doc Text)
blockToMuseWithNotes blk = do
topLevel <- asks envTopLevel
opts <- asks envOptions
@@ -501,7 +501,7 @@ inlineListStartsWithAlnum _ = return False
-- | Convert list of Pandoc inline elements to Muse
renderInlineList :: PandocMonad m
=> [Inline]
- -> Muse m Doc
+ -> Muse m (Doc Text)
renderInlineList [] = pure ""
renderInlineList (x:xs) = do
start <- asks envInlineStart
@@ -531,7 +531,7 @@ renderInlineList (x:xs) = do
-- | Normalize and convert list of Pandoc inline elements to Muse.
inlineListToMuse :: PandocMonad m
=> [Inline]
- -> Muse m Doc
+ -> Muse m (Doc Text)
inlineListToMuse lst = do
lst' <- normalizeInlineList . fixNotes <$> preprocessInlineList (map (removeKeyValues . replaceSmallCaps) lst)
insideAsterisks <- asks envInsideAsterisks
@@ -541,7 +541,7 @@ inlineListToMuse lst = do
then pure "<verbatim></verbatim>"
else local (\env -> env { envNearAsterisks = insideAsterisks }) $ renderInlineList lst'
-inlineListToMuse' :: PandocMonad m => [Inline] -> Muse m Doc
+inlineListToMuse' :: PandocMonad m => [Inline] -> Muse m (Doc Text)
inlineListToMuse' lst = do
topLevel <- asks envTopLevel
afterSpace <- asks envAfterSpace
@@ -549,7 +549,7 @@ inlineListToMuse' lst = do
, envAfterSpace = afterSpace || not topLevel
}) $ inlineListToMuse lst
-emphasis :: PandocMonad m => String -> String -> [Inline] -> Muse m Doc
+emphasis :: PandocMonad m => String -> String -> [Inline] -> Muse m (Doc Text)
emphasis b e lst = do
contents <- local (\env -> env { envInsideAsterisks = inAsterisks }) $ inlineListToMuse lst
modify $ \st -> st { stUseTags = useTags }
@@ -560,7 +560,7 @@ emphasis b e lst = do
-- | Convert Pandoc inline element to Muse.
inlineToMuse :: PandocMonad m
=> Inline
- -> Muse m Doc
+ -> Muse m (Doc Text)
inlineToMuse (Str str) = do
escapedStr <- conditionalEscapeString $ replaceNewlines str
let useTags = isAlphaNum $ last escapedStr -- escapedStr is never empty because empty strings are escaped
diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index 7dd07c89f..8040bd787 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -19,15 +19,15 @@ import Data.Text (Text)
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options (WrapOption (..), WriterOptions (..))
-import Text.Pandoc.Pretty
+import Text.DocLayout
-prettyList :: [Doc] -> Doc
+prettyList :: [Doc Text] -> Doc Text
prettyList ds =
"[" <>
- cat (intersperse (cr <> ",") $ map (nest 1) ds) <> "]"
+ mconcat (intersperse (cr <> ",") $ map (nest 1) ds) <> "]"
-- | Prettyprint Pandoc block element.
-prettyBlock :: Block -> Doc
+prettyBlock :: Block -> Doc Text
prettyBlock (LineBlock lines') =
"LineBlock" $$ prettyList (map (text . show) lines')
prettyBlock (BlockQuote blocks) =
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index f98515397..3d8bfbca7 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -32,7 +32,7 @@ import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)
import Text.Pandoc.Options (WrapOption (..), WriterOptions (..))
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared (stringify, pandocVersion)
import Text.Pandoc.Writers.Shared (lookupMetaString, lookupMetaBlocks,
fixDisplayMath)
diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs
index 14d29edd6..7bbb026bb 100644
--- a/src/Text/Pandoc/Writers/OPML.hs
+++ b/src/Text/Pandoc/Writers/OPML.hs
@@ -14,7 +14,7 @@ Conversion of 'Pandoc' documents to OPML XML.
module Text.Pandoc.Writers.OPML ( writeOPML) where
import Prelude
import Control.Monad.Except (throwError)
-import Data.Text (Text, unpack)
+import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad)
@@ -22,7 +22,7 @@ import Data.Time
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.HTML (writeHtml5String)
@@ -38,7 +38,7 @@ writeOPML opts (Pandoc meta blocks) = do
then Just $ writerColumns opts
else Nothing
meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta
- metadata <- metaToJSON opts
+ metadata <- metaToContext opts
(writeMarkdown def . Pandoc nullMeta)
(\ils -> T.stripEnd <$> writeMarkdown def (Pandoc nullMeta [Plain ils]))
meta'
@@ -64,7 +64,7 @@ convertDate ils = maybe "" showDateTimeRFC822 $
parseTimeM True defaultTimeLocale "%F" =<< normalizeDate (stringify ils)
-- | Convert an Element to OPML.
-elementToOPML :: PandocMonad m => WriterOptions -> Element -> m Doc
+elementToOPML :: PandocMonad m => WriterOptions -> Element -> m (Doc Text)
elementToOPML _ (Blk _) = return empty
elementToOPML opts (Sec _ _num _ title elements) = do
let isBlk :: Element -> Bool
@@ -81,7 +81,7 @@ elementToOPML opts (Sec _ _num _ title elements) = do
then return mempty
else do blks <- mapM fromBlk blocks
writeMarkdown def $ Pandoc nullMeta blks
- let attrs = ("text", unpack htmlIls) :
- [("_note", unpack md) | not (null blocks)]
+ let attrs = ("text", T.unpack htmlIls) :
+ [("_note", T.unpack $ T.stripEnd md) | not (null blocks)]
o <- mapM (elementToOPML opts) rest
return $ inTags True "outline" attrs $ vcat o
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 4bc51fd20..3da778ae9 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -30,7 +30,7 @@ import Text.Pandoc.Class (PandocMonad, report, translateTerm,
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared (linesToPara)
import Text.Pandoc.Templates (renderTemplate)
import qualified Text.Pandoc.Translations as Term (Term(Figure, Table))
@@ -51,11 +51,12 @@ plainToPara x = x
type OD m = StateT WriterState m
data WriterState =
- WriterState { stNotes :: [Doc]
- , stTableStyles :: [Doc]
- , stParaStyles :: [Doc]
- , stListStyles :: [(Int, [Doc])]
- , stTextStyles :: Map.Map (Set.Set TextStyle) (String, Doc)
+ WriterState { stNotes :: [Doc Text]
+ , stTableStyles :: [Doc Text]
+ , stParaStyles :: [Doc Text]
+ , stListStyles :: [(Int, [Doc Text])]
+ , stTextStyles :: Map.Map (Set.Set TextStyle)
+ (String, Doc Text)
, stTextStyleAttr :: Set.Set TextStyle
, stIndentPara :: Int
, stInDefinition :: Bool
@@ -83,19 +84,20 @@ defaultWriterState =
, stImageCaptionId = 1
}
-when :: Bool -> Doc -> Doc
+when :: Bool -> Doc Text -> Doc Text
when p a = if p then a else empty
-addTableStyle :: PandocMonad m => Doc -> OD m ()
+addTableStyle :: PandocMonad m => Doc Text -> OD m ()
addTableStyle i = modify $ \s -> s { stTableStyles = i : stTableStyles s }
-addNote :: PandocMonad m => Doc -> OD m ()
+addNote :: PandocMonad m => Doc Text -> OD m ()
addNote i = modify $ \s -> s { stNotes = i : stNotes s }
-addParaStyle :: PandocMonad m => Doc -> OD m ()
+addParaStyle :: PandocMonad m => Doc Text -> OD m ()
addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s }
-addTextStyle :: PandocMonad m => Set.Set TextStyle -> (String, Doc) -> OD m ()
+addTextStyle :: PandocMonad m
+ => Set.Set TextStyle -> (String, Doc Text) -> OD m ()
addTextStyle attrs i = modify $ \s ->
s { stTextStyles = Map.insert attrs i (stTextStyles s) }
@@ -119,7 +121,7 @@ setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
setFirstPara :: PandocMonad m => OD m ()
setFirstPara = modify $ \s -> s { stFirstPara = True }
-inParagraphTags :: PandocMonad m => Doc -> OD m Doc
+inParagraphTags :: PandocMonad m => Doc Text -> OD m (Doc Text)
inParagraphTags d = do
b <- gets stFirstPara
a <- if b
@@ -128,10 +130,10 @@ inParagraphTags d = do
else return [("text:style-name", "Text_20_body")]
return $ inTags False "text:p" a d
-inParagraphTagsWithStyle :: String -> Doc -> Doc
+inParagraphTagsWithStyle :: String -> Doc Text -> Doc Text
inParagraphTagsWithStyle sty = inTags False "text:p" [("text:style-name", sty)]
-inSpanTags :: String -> Doc -> Doc
+inSpanTags :: String -> Doc Text -> Doc Text
inSpanTags s = inTags False "text:span" [("text:style-name",s)]
withTextStyle :: PandocMonad m => TextStyle -> OD m a -> OD m a
@@ -142,7 +144,7 @@ withTextStyle s f = do
modify $ \st -> st{ stTextStyleAttr = oldTextStyleAttr }
return res
-inTextStyle :: PandocMonad m => Doc -> OD m Doc
+inTextStyle :: PandocMonad m => Doc Text -> OD m (Doc Text)
inTextStyle d = do
at <- gets stTextStyleAttr
if Set.null at
@@ -164,10 +166,10 @@ inTextStyle d = do
return $ inTags False
"text:span" [("text:style-name",styleName)] d
-formulaStyles :: [Doc]
+formulaStyles :: [Doc Text]
formulaStyles = [formulaStyle InlineMath, formulaStyle DisplayMath]
-formulaStyle :: MathType -> Doc
+formulaStyle :: MathType -> Doc Text
formulaStyle mt = inTags False "style:style"
[("style:name", if mt == InlineMath then "fr1" else "fr2")
,("style:family", "graphic")
@@ -182,7 +184,7 @@ formulaStyle mt = inTags False "style:style"
,("style:horizontal-rel", "paragraph-content")
,("style:wrap", "none")]
-inHeaderTags :: PandocMonad m => Int -> String -> Doc -> OD m Doc
+inHeaderTags :: PandocMonad m => Int -> String -> Doc Text -> OD m (Doc Text)
inHeaderTags i ident d =
return $ inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i)
, ("text:outline-level", show i)]
@@ -192,11 +194,11 @@ inHeaderTags i ident d =
<> d <>
selfClosingTag "text:bookmark-end" [ ("text:name", ident) ]
-inQuotes :: QuoteType -> Doc -> Doc
+inQuotes :: QuoteType -> Doc Text -> Doc Text
inQuotes SingleQuote s = char '\8216' <> s <> char '\8217'
inQuotes DoubleQuote s = char '\8220' <> s <> char '\8221'
-handleSpaces :: String -> Doc
+handleSpaces :: String -> Doc Text
handleSpaces s
| ( ' ':_) <- s = genTag s
| ('\t':x) <- s = selfClosingTag "text:tab" [] <> rm x
@@ -220,15 +222,13 @@ writeOpenDocument opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
((body, metadata),s) <- flip runStateT
defaultWriterState $ do
- m <- metaToJSON opts
- (fmap render' . blocksToOpenDocument opts)
- (fmap render' . inlinesToOpenDocument opts)
+ m <- metaToContext opts
+ (blocksToOpenDocument opts)
+ (fmap chomp . inlinesToOpenDocument opts)
meta
- b <- render' `fmap` blocksToOpenDocument opts blocks
+ b <- blocksToOpenDocument opts blocks
return (b, m)
let styles = stTableStyles s ++ stParaStyles s ++ formulaStyles ++
map snd (sortBy (flip (comparing fst)) (
@@ -239,33 +239,34 @@ writeOpenDocument opts (Pandoc meta blocks) = do
let automaticStyles = vcat $ reverse $ styles ++ listStyles
let context = defField "body" body
$ defField "toc" (writerTableOfContents opts)
- $defField "automatic-styles" (render' automaticStyles) metadata
- return $
+ $ defField "automatic-styles" automaticStyles
+ $ metadata
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> body
Just tpl -> renderTemplate tpl context
withParagraphStyle :: PandocMonad m
- => WriterOptions -> String -> [Block] -> OD m Doc
+ => WriterOptions -> String -> [Block] -> OD m (Doc Text)
withParagraphStyle o s (b:bs)
| Para l <- b = go =<< inParagraphTagsWithStyle s <$> inlinesToOpenDocument o l
| otherwise = go =<< blockToOpenDocument o b
where go i = (<>) i <$> withParagraphStyle o s bs
withParagraphStyle _ _ [] = return empty
-inPreformattedTags :: PandocMonad m => String -> OD m Doc
+inPreformattedTags :: PandocMonad m => String -> OD m (Doc Text)
inPreformattedTags s = do
n <- paraStyle [("style:parent-style-name","Preformatted_20_Text")]
return . inParagraphTagsWithStyle ("P" ++ show n) . handleSpaces $ s
orderedListToOpenDocument :: PandocMonad m
- => WriterOptions -> Int -> [[Block]] -> OD m Doc
+ => WriterOptions -> Int -> [[Block]] -> OD m (Doc Text)
orderedListToOpenDocument o pn bs =
vcat . map (inTagsIndented "text:list-item") <$>
mapM (orderedItemToOpenDocument o pn . map plainToPara) bs
orderedItemToOpenDocument :: PandocMonad m
- => WriterOptions -> Int -> [Block] -> OD m Doc
+ => WriterOptions -> Int -> [Block] -> OD m (Doc Text)
orderedItemToOpenDocument o n bs = vcat <$> mapM go bs
where go (OrderedList a l) = newLevel a l
go (Para l) = inParagraphTagsWithStyle ("P" ++ show n) <$>
@@ -294,7 +295,7 @@ newOrderedListStyle b a = do
return (ln,pn)
bulletListToOpenDocument :: PandocMonad m
- => WriterOptions -> [[Block]] -> OD m Doc
+ => WriterOptions -> [[Block]] -> OD m (Doc Text)
bulletListToOpenDocument o b = do
ln <- (+) 1 . length <$> gets stListStyles
(pn,ns) <- if isTightList b then inTightList (bulletListStyle ln) else bulletListStyle ln
@@ -303,12 +304,12 @@ bulletListToOpenDocument o b = do
return $ inTags True "text:list" [("text:style-name", "L" ++ show ln)] is
listItemsToOpenDocument :: PandocMonad m
- => String -> WriterOptions -> [[Block]] -> OD m Doc
+ => String -> WriterOptions -> [[Block]] -> OD m (Doc Text)
listItemsToOpenDocument s o is =
vcat . map (inTagsIndented "text:list-item") <$> mapM (withParagraphStyle o s . map plainToPara) is
deflistItemToOpenDocument :: PandocMonad m
- => WriterOptions -> ([Inline],[[Block]]) -> OD m Doc
+ => WriterOptions -> ([Inline],[[Block]]) -> OD m (Doc Text)
deflistItemToOpenDocument o (t,d) = do
let ts = if isTightList d
then "Definition_20_Term_20_Tight" else "Definition_20_Term"
@@ -319,7 +320,7 @@ deflistItemToOpenDocument o (t,d) = do
return $ t' $$ d'
inBlockQuote :: PandocMonad m
- => WriterOptions -> Int -> [Block] -> OD m Doc
+ => WriterOptions -> Int -> [Block] -> OD m (Doc Text)
inBlockQuote o i (b:bs)
| BlockQuote l <- b = do increaseIndent
ni <- paraStyle
@@ -331,11 +332,11 @@ inBlockQuote o i (b:bs)
inBlockQuote _ _ [] = resetIndent >> return empty
-- | Convert a list of Pandoc blocks to OpenDocument.
-blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m Doc
+blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument o b = vcat <$> mapM (blockToOpenDocument o) b
-- | Convert a Pandoc block element to OpenDocument.
-blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m Doc
+blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument o bs
| Plain b <- bs = if null b
then return empty
@@ -417,21 +418,21 @@ blockToOpenDocument o bs
return $ imageDoc $$ captionDoc
-numberedTableCaption :: PandocMonad m => Doc -> OD m Doc
+numberedTableCaption :: PandocMonad m => Doc Text -> OD m (Doc Text)
numberedTableCaption caption = do
id' <- gets stTableCaptionId
modify (\st -> st{ stTableCaptionId = id' + 1 })
capterm <- translateTerm Term.Table
return $ numberedCaption "Table" capterm "Table" id' caption
-numberedFigureCaption :: PandocMonad m => Doc -> OD m Doc
+numberedFigureCaption :: PandocMonad m => Doc Text -> OD m (Doc Text)
numberedFigureCaption caption = do
id' <- gets stImageCaptionId
modify (\st -> st{ stImageCaptionId = id' + 1 })
capterm <- translateTerm Term.Figure
return $ numberedCaption "FigureCaption" capterm "Illustration" id' caption
-numberedCaption :: String -> String -> String -> Int -> Doc -> Doc
+numberedCaption :: String -> String -> String -> Int -> Doc Text -> Doc Text
numberedCaption style term name num caption =
let t = text term
r = num - 1
@@ -442,26 +443,26 @@ numberedCaption style term name num caption =
c = text ": "
in inParagraphTagsWithStyle style $ hcat [ t, text " ", s, c, caption ]
-unNumberedCaption :: Monad m => String -> Doc -> OD m Doc
+unNumberedCaption :: Monad m => String -> Doc Text -> OD m (Doc Text)
unNumberedCaption style caption = return $ inParagraphTagsWithStyle style caption
colHeadsToOpenDocument :: PandocMonad m
=> WriterOptions -> [String] -> [[Block]]
- -> OD m Doc
+ -> OD m (Doc Text)
colHeadsToOpenDocument o ns hs =
inTagsIndented "table:table-header-rows" . inTagsIndented "table:table-row" . vcat <$>
mapM (tableItemToOpenDocument o "TableHeaderRowCell") (zip ns hs)
tableRowToOpenDocument :: PandocMonad m
=> WriterOptions -> [String] -> [[Block]]
- -> OD m Doc
+ -> OD m (Doc Text)
tableRowToOpenDocument o ns cs =
inTagsIndented "table:table-row" . vcat <$>
mapM (tableItemToOpenDocument o "TableRowCell") (zip ns cs)
tableItemToOpenDocument :: PandocMonad m
=> WriterOptions -> String -> (String,[Block])
- -> OD m Doc
+ -> OD m (Doc Text)
tableItemToOpenDocument o s (n,i) =
let a = [ ("table:style-name" , s )
, ("office:value-type", "string" )
@@ -470,10 +471,10 @@ tableItemToOpenDocument o s (n,i) =
withParagraphStyle o n (map plainToPara i)
-- | Convert a list of inline elements to OpenDocument.
-inlinesToOpenDocument :: PandocMonad m => WriterOptions -> [Inline] -> OD m Doc
+inlinesToOpenDocument :: PandocMonad m => WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument o l = hcat <$> toChunks o l
-toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc]
+toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks _ [] = return []
toChunks o (x : xs)
| isChunkable x = do
@@ -494,7 +495,7 @@ isChunkable SoftBreak = True
isChunkable _ = False
-- | Convert an inline element to OpenDocument.
-inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m Doc
+inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument o ils
= case ils of
Space -> return space
@@ -557,7 +558,7 @@ inlineToOpenDocument o ils
addNote nn
return nn
-bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc]))
+bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc Text]))
bulletListStyle l = do
let doStyles i = inTags True "text:list-level-style-bullet"
[ ("text:level" , show (i + 1) )
@@ -570,7 +571,7 @@ bulletListStyle l = do
pn <- paraListStyle l
return (pn, (l, listElStyle))
-orderedListLevelStyle :: ListAttributes -> (Int, [Doc]) -> (Int,[Doc])
+orderedListLevelStyle :: ListAttributes -> (Int, [Doc Text]) -> (Int,[Doc Text])
orderedListLevelStyle (s,n, d) (l,ls) =
let suffix = case d of
OneParen -> [("style:num-suffix", ")")]
@@ -591,7 +592,7 @@ orderedListLevelStyle (s,n, d) (l,ls) =
] ++ suffix) (listLevelStyle (1 + length ls))
in (l, ls ++ [listStyle])
-listLevelStyle :: Int -> Doc
+listLevelStyle :: Int -> Doc Text
listLevelStyle i =
let indent = show (0.25 + (0.25 * fromIntegral i :: Double)) in
inTags True "style:list-level-properties"
@@ -606,7 +607,7 @@ listLevelStyle i =
, ("fo:margin-left", indent ++ "in")
]
-tableStyle :: Int -> [(Char,Double)] -> Doc
+tableStyle :: Int -> [(Char,Double)] -> Doc Text
tableStyle num wcs =
let tableId = "Table" ++ show (num + 1)
table = inTags True "style:style"
@@ -669,7 +670,7 @@ paraListStyle l = paraStyle
[("style:parent-style-name","Text_20_body")
,("style:list-style-name", "L" ++ show l )]
-paraTableStyles :: String -> Int -> [Alignment] -> [(String, Doc)]
+paraTableStyles :: String -> Int -> [Alignment] -> [(String, Doc Text)]
paraTableStyles _ _ [] = []
paraTableStyles t s (a:xs)
| AlignRight <- a = ( pName s, res s "end" ) : paraTableStyles t (s + 1) xs
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 43b4c2add..3c4f1b237 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -25,7 +25,7 @@ import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@@ -53,31 +53,29 @@ pandocToOrg (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
- metadata <- metaToJSON opts
- (fmap render' . blockListToOrg)
- (fmap render' . inlineListToOrg)
+ metadata <- metaToContext opts
+ blockListToOrg
+ (fmap chomp . inlineListToOrg)
meta
body <- blockListToOrg blocks
notes <- gets (reverse . stNotes) >>= notesToOrg
hasMath <- gets stHasMath
- let main = render colwidth . foldl ($+$) empty $ [body, notes]
+ let main = body $+$ notes
let context = defField "body" main
. defField "math" hasMath
$ metadata
- return $
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Return Org representation of notes.
-notesToOrg :: PandocMonad m => [[Block]] -> Org m Doc
+notesToOrg :: PandocMonad m => [[Block]] -> Org m (Doc Text)
notesToOrg notes =
vsep <$> zipWithM noteToOrg [1..] notes
-- | Return Org representation of a note.
-noteToOrg :: PandocMonad m => Int -> [Block] -> Org m Doc
+noteToOrg :: PandocMonad m => Int -> [Block] -> Org m (Doc Text)
noteToOrg num note = do
contents <- blockListToOrg note
let marker = "[fn:" ++ show num ++ "] "
@@ -99,7 +97,7 @@ isRawFormat f =
-- | Convert Pandoc block element to Org.
blockToOrg :: PandocMonad m
=> Block -- ^ Block element
- -> Org m Doc
+ -> Org m (Doc Text)
blockToOrg Null = return empty
blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do
contents <- blockListToOrg bs
@@ -198,10 +196,9 @@ blockToOrg (Table caption' _ _ headers rows) = do
map ((+2) . numChars) $ transpose (headers' : rawRows)
-- FIXME: Org doesn't allow blocks with height more than 1.
let hpipeBlocks blocks = hcat [beg, middle, end]
- where h = maximum (1 : map height blocks)
- sep' = lblock 3 $ vcat (replicate h (text " | "))
- beg = lblock 2 $ vcat (replicate h (text "| "))
- end = lblock 2 $ vcat (replicate h (text " |"))
+ where sep' = vfill " | "
+ beg = vfill "| "
+ end = vfill " |"
middle = hcat $ intersperse sep' blocks
let makeRow = hpipeBlocks . zipWith lblock widthsInChars
let head' = makeRow headers'
@@ -219,7 +216,9 @@ blockToOrg (Table caption' _ _ headers rows) = do
blockToOrg (BulletList items) = do
contents <- mapM bulletListItemToOrg items
-- ensure that sublists have preceding blank line
- return $ blankline $+$ vcat contents $$ blankline
+ return $ blankline $$
+ (if isTightList items then vcat else vsep) contents $$
+ blankline
blockToOrg (OrderedList (start, _, delim) items) = do
let delim' = case delim of
TwoParens -> OneParen
@@ -231,36 +230,48 @@ blockToOrg (OrderedList (start, _, delim) items) = do
in m ++ replicate s ' ') markers
contents <- zipWithM orderedListItemToOrg markers' items
-- ensure that sublists have preceding blank line
- return $ blankline $$ vcat contents $$ blankline
+ return $ blankline $$
+ (if isTightList items then vcat else vsep) contents $$
+ blankline
blockToOrg (DefinitionList items) = do
contents <- mapM definitionListItemToOrg items
return $ vcat contents $$ blankline
-- | Convert bullet list item (list of blocks) to Org.
-bulletListItemToOrg :: PandocMonad m => [Block] -> Org m Doc
+bulletListItemToOrg :: PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg items = do
contents <- blockListToOrg items
- return $ hang 2 "- " (contents <> cr)
+ return $ hang 2 "- " contents $$
+ if endsWithPlain items
+ then cr
+ else blankline
+
-- | Convert ordered list item (a list of blocks) to Org.
orderedListItemToOrg :: PandocMonad m
=> String -- ^ marker for list item
-> [Block] -- ^ list item (list of blocks)
- -> Org m Doc
+ -> Org m (Doc Text)
orderedListItemToOrg marker items = do
contents <- blockListToOrg items
- return $ hang (length marker + 1) (text marker <> space) (contents <> cr)
+ return $ hang (length marker + 1) (text marker <> space) contents $$
+ if endsWithPlain items
+ then cr
+ else blankline
-- | Convert definition list item (label, list of blocks) to Org.
definitionListItemToOrg :: PandocMonad m
- => ([Inline], [[Block]]) -> Org m Doc
+ => ([Inline], [[Block]]) -> Org m (Doc Text)
definitionListItemToOrg (label, defs) = do
label' <- inlineListToOrg label
contents <- vcat <$> mapM blockListToOrg defs
- return . hang 2 "- " $ label' <> " :: " <> (contents <> cr)
+ return $ hang 2 "- " (label' <> " :: " <> contents) $$
+ if isTightList defs
+ then cr
+ else blankline
-- | Convert list of key/value pairs to Org :PROPERTIES: drawer.
-propertiesDrawer :: Attr -> Doc
+propertiesDrawer :: Attr -> Doc Text
propertiesDrawer (ident, classes, kv) =
let
drawerStart = text ":PROPERTIES:"
@@ -271,11 +282,11 @@ propertiesDrawer (ident, classes, kv) =
in
drawerStart <> cr <> properties <> cr <> drawerEnd
where
- kvToOrgProperty :: (String, String) -> Doc
+ kvToOrgProperty :: (String, String) -> Doc Text
kvToOrgProperty (key, value) =
text ":" <> text key <> text ": " <> text value <> cr
-attrHtml :: Attr -> Doc
+attrHtml :: Attr -> Doc Text
attrHtml ("" , [] , []) = mempty
attrHtml (ident, classes, kvs) =
let
@@ -288,13 +299,13 @@ attrHtml (ident, classes, kvs) =
-- | Convert list of Pandoc block elements to Org.
blockListToOrg :: PandocMonad m
=> [Block] -- ^ List of block elements
- -> Org m Doc
+ -> Org m (Doc Text)
blockListToOrg blocks = vcat <$> mapM blockToOrg blocks
-- | Convert list of Pandoc inline elements to Org.
inlineListToOrg :: PandocMonad m
=> [Inline]
- -> Org m Doc
+ -> Org m (Doc Text)
inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixMarkers lst)
where fixMarkers [] = [] -- prevent note refs and list markers from wrapping, see #4171
fixMarkers (Space : x : rest) | shouldFix x =
@@ -309,7 +320,7 @@ inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixMarkers lst)
shouldFix _ = False
-- | Convert Pandoc inline element to Org.
-inlineToOrg :: PandocMonad m => Inline -> Org m Doc
+inlineToOrg :: PandocMonad m => Inline -> Org m (Doc Text)
inlineToOrg (Span (uid, [], []) []) =
return $ "<<" <> text uid <> ">>"
inlineToOrg (Span _ lst) =
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index ebfc599f4..4d332b9e1 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -17,16 +17,17 @@ module Text.Pandoc.Writers.RST ( writeRST, flatten ) where
import Prelude
import Control.Monad.State.Strict
import Data.Char (isSpace, toLower)
-import Data.List (isPrefixOf, stripPrefix, transpose)
+import Data.List (isPrefixOf, stripPrefix, transpose, intersperse)
import Data.Maybe (fromMaybe)
-import Data.Text (Text, stripEnd)
+import qualified Data.Text as T
+import Data.Text (Text)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@@ -62,13 +63,11 @@ pandocToRST (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
let subtit = lookupMetaInlines "subtitle" meta
title <- titleToRST (docTitle meta) subtit
- metadata <- metaToJSON opts
- (fmap render' . blockListToRST)
- (fmap (stripEnd . render') . inlineListToRST)
+ metadata <- metaToContext opts
+ blockListToRST
+ (fmap chomp . inlineListToRST)
meta
body <- blockListToRST' True $ case writerTemplate opts of
Just _ -> normalizeHeadings 1 blocks
@@ -79,16 +78,16 @@ pandocToRST (Pandoc meta blocks) = do
pics <- gets (reverse . stImages) >>= pictRefsToRST
hasMath <- gets stHasMath
rawTeX <- gets stHasRawTeX
- let main = render' $ foldl ($+$) empty [body, notes, refs, pics]
+ let main = vsep [body, notes, refs, pics]
let context = defField "body" main
$ defField "toc" (writerTableOfContents opts)
- $ defField "toc-depth" (show $ writerTOCDepth opts)
+ $ defField "toc-depth" (T.pack $ show $ writerTOCDepth opts)
$ defField "number-sections" (writerNumberSections opts)
$ defField "math" hasMath
- $ defField "titleblock" (render Nothing title :: String)
+ $ defField "titleblock" (render Nothing title :: Text)
$ defField "math" hasMath
$ defField "rawtex" rawTeX metadata
- return $
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@@ -102,26 +101,26 @@ pandocToRST (Pandoc meta blocks) = do
normalizeHeadings _ [] = []
-- | Return RST representation of reference key table.
-refsToRST :: PandocMonad m => Refs -> RST m Doc
+refsToRST :: PandocMonad m => Refs -> RST m (Doc Text)
refsToRST refs = mapM keyToRST refs >>= return . vcat
-- | Return RST representation of a reference key.
-keyToRST :: PandocMonad m => ([Inline], (String, String)) -> RST m Doc
+keyToRST :: PandocMonad m => ([Inline], (String, String)) -> RST m (Doc Text)
keyToRST (label, (src, _)) = do
label' <- inlineListToRST label
- let label'' = if ':' `elem` (render Nothing label' :: String)
+ let label'' = if (==':') `T.any` (render Nothing label' :: Text)
then char '`' <> label' <> char '`'
else label'
return $ nowrap $ ".. _" <> label'' <> ": " <> text src
-- | Return RST representation of notes.
-notesToRST :: PandocMonad m => [[Block]] -> RST m Doc
+notesToRST :: PandocMonad m => [[Block]] -> RST m (Doc Text)
notesToRST notes =
zipWithM noteToRST [1..] notes >>=
return . vsep
-- | Return RST representation of a note.
-noteToRST :: PandocMonad m => Int -> [Block] -> RST m Doc
+noteToRST :: PandocMonad m => Int -> [Block] -> RST m (Doc Text)
noteToRST num note = do
contents <- blockListToRST note
let marker = ".. [" <> text (show num) <> "]"
@@ -130,13 +129,13 @@ noteToRST num note = do
-- | Return RST representation of picture reference table.
pictRefsToRST :: PandocMonad m
=> [([Inline], (Attr, String, String, Maybe String))]
- -> RST m Doc
+ -> RST m (Doc Text)
pictRefsToRST refs = mapM pictToRST refs >>= return . vcat
-- | Return RST representation of a picture substitution reference.
pictToRST :: PandocMonad m
=> ([Inline], (Attr, String, String, Maybe String))
- -> RST m Doc
+ -> RST m (Doc Text)
pictToRST (label, (attr, src, _, mbtarget)) = do
label' <- inlineListToRST label
dims <- imageDimsToRST attr
@@ -171,14 +170,14 @@ escapeString = escapeString' True
_ -> '.':escapeString' False opts cs
_ -> c : escapeString' False opts cs
-titleToRST :: PandocMonad m => [Inline] -> [Inline] -> RST m Doc
+titleToRST :: PandocMonad m => [Inline] -> [Inline] -> RST m (Doc Text)
titleToRST [] _ = return empty
titleToRST tit subtit = do
title <- inlineListToRST tit
subtitle <- inlineListToRST subtit
return $ bordered title '=' $$ bordered subtitle '-'
-bordered :: Doc -> Char -> Doc
+bordered :: Doc Text -> Char -> Doc Text
bordered contents c =
if len > 0
then border $$ contents $$ border
@@ -189,7 +188,7 @@ bordered contents c =
-- | Convert Pandoc block element to RST.
blockToRST :: PandocMonad m
=> Block -- ^ Block element
- -> RST m Doc
+ -> RST m (Doc Text)
blockToRST Null = return empty
blockToRST (Div ("",["admonition-title"],[]) _) = return empty
-- this is generated by the rst reader and can safely be
@@ -301,7 +300,9 @@ blockToRST (Table caption aligns widths headers rows) = do
blockToRST (BulletList items) = do
contents <- mapM bulletListItemToRST items
-- ensure that sublists have preceding blank line
- return $ blankline $$ chomp (vcat contents) $$ blankline
+ return $ blankline $$
+ (if isTightList items then vcat else vsep) contents $$
+ blankline
blockToRST (OrderedList (start, style', delim) items) = do
let markers = if start == 1 && style' == DefaultStyle && delim == DefaultDelim
then replicate (length items) "#."
@@ -312,37 +313,48 @@ blockToRST (OrderedList (start, style', delim) items) = do
in m ++ replicate s ' ') markers
contents <- zipWithM orderedListItemToRST markers' items
-- ensure that sublists have preceding blank line
- return $ blankline $$ chomp (vcat contents) $$ blankline
+ return $ blankline $$
+ (if isTightList items then vcat else vsep) contents $$
+ blankline
blockToRST (DefinitionList items) = do
contents <- mapM definitionListItemToRST items
-- ensure that sublists have preceding blank line
- return $ blankline $$ chomp (vcat contents) $$ blankline
+ return $ blankline $$ vcat contents $$ blankline
-- | Convert bullet list item (list of blocks) to RST.
-bulletListItemToRST :: PandocMonad m => [Block] -> RST m Doc
+bulletListItemToRST :: PandocMonad m => [Block] -> RST m (Doc Text)
bulletListItemToRST items = do
contents <- blockListToRST items
- return $ hang 3 "- " $ contents <> cr
+ return $ hang 3 "- " contents $$
+ if endsWithPlain items
+ then cr
+ else blankline
-- | Convert ordered list item (a list of blocks) to RST.
orderedListItemToRST :: PandocMonad m
=> String -- ^ marker for list item
-> [Block] -- ^ list item (list of blocks)
- -> RST m Doc
+ -> RST m (Doc Text)
orderedListItemToRST marker items = do
contents <- blockListToRST items
let marker' = marker ++ " "
- return $ hang (length marker') (text marker') $ contents <> cr
+ return $ hang (length marker') (text marker') contents $$
+ if endsWithPlain items
+ then cr
+ else blankline
-- | Convert definition list item (label, list of blocks) to RST.
-definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m Doc
+definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST (label, defs) = do
label' <- inlineListToRST label
contents <- liftM vcat $ mapM blockListToRST defs
- return $ nowrap label' $$ nest 3 (nestle contents <> cr)
+ return $ nowrap label' $$ nest 3 (nestle contents) $$
+ if isTightList defs
+ then cr
+ else blankline
-- | Format a list of lines as line block.
-linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m Doc
+linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m (Doc Text)
linesToLineBlock inlineLines = do
lns <- mapM inlineListToRST inlineLines
return $
@@ -352,7 +364,7 @@ linesToLineBlock inlineLines = do
blockListToRST' :: PandocMonad m
=> Bool
-> [Block] -- ^ List of block elements
- -> RST m Doc
+ -> RST m (Doc Text)
blockListToRST' topLevel blocks = do
-- insert comment between list and quoted blocks, see #4248 and #3675
let fixBlocks (b1:b2@(BlockQuote _):bs)
@@ -376,7 +388,7 @@ blockListToRST' topLevel blocks = do
blockListToRST :: PandocMonad m
=> [Block] -- ^ List of block elements
- -> RST m Doc
+ -> RST m (Doc Text)
blockListToRST = blockListToRST' False
transformInlines :: [Inline] -> [Inline]
@@ -532,15 +544,15 @@ 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 :: PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST = writeInlines . walk transformInlines
-- | Convert list of Pandoc inline elements to RST.
-writeInlines :: PandocMonad m => [Inline] -> RST m Doc
+writeInlines :: PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines lst = mapM inlineToRST lst >>= return . hcat
-- | Convert Pandoc inline element to RST.
-inlineToRST :: PandocMonad m => Inline -> RST m Doc
+inlineToRST :: PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST (Span (_,_,kvs) ils) = do
contents <- writeInlines ils
return $
@@ -653,7 +665,7 @@ inlineToRST (Note contents) = do
let ref = show $ length notes + 1
return $ " [" <> text ref <> "]_"
-registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe String -> RST m Doc
+registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe String -> RST m (Doc Text)
registerImage attr alt (src,tit) mbtarget = do
pics <- gets stImages
txt <- case lookup alt pics of
@@ -668,7 +680,7 @@ registerImage attr alt (src,tit) mbtarget = do
return alt'
inlineListToRST txt
-imageDimsToRST :: PandocMonad m => Attr -> RST m Doc
+imageDimsToRST :: PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST attr = do
let (ident, _, _) = attr
name = if null ident
@@ -686,10 +698,10 @@ imageDimsToRST attr = do
simpleTable :: PandocMonad m
=> WriterOptions
- -> (WriterOptions -> [Block] -> m Doc)
+ -> (WriterOptions -> [Block] -> m (Doc Text))
-> [[Block]]
-> [[[Block]]]
- -> m Doc
+ -> m (Doc Text)
simpleTable opts blocksToDoc headers rows = do
-- can't have empty cells in first column:
let fixEmpties (d:ds) = if isEmpty d
@@ -703,7 +715,7 @@ simpleTable opts blocksToDoc headers rows = do
let numChars [] = 0
numChars xs = maximum . map offset $ xs
let colWidths = map numChars $ transpose (headerDocs : rowDocs)
- let toRow = hsep . zipWith lblock colWidths
+ let toRow = mconcat . intersperse (lblock 1 " ") . zipWith lblock colWidths
let hline = nowrap $ hsep (map (\n -> text (replicate n '=')) colWidths)
let hdr = if all null headers
then mempty
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index 61ee7804b..3a5e00845 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -96,7 +96,7 @@ writeRTF options doc = do
. M.adjust toPlain "author"
. M.adjust toPlain "date"
$ metamap
- metadata <- metaToJSON options
+ metadata <- metaToContext options
(fmap concat . mapM (blockToRTF 0 AlignDefault))
inlinesToRTF
meta'
@@ -112,11 +112,10 @@ writeRTF options doc = do
-- of the toc rather than a boolean:
. defField "toc" toc
else id) metadata
- return $
+ return $ T.pack $
case writerTemplate options of
Just tpl -> renderTemplate tpl context
- Nothing -> T.pack $
- case reverse body of
+ Nothing -> case reverse body of
('\n':_) -> body
_ -> body ++ "\n"
diff --git a/src/Text/Pandoc/Writers/Roff.hs b/src/Text/Pandoc/Writers/Roff.hs
index e2be87d94..fdd5db4dd 100644
--- a/src/Text/Pandoc/Writers/Roff.hs
+++ b/src/Text/Pandoc/Writers/Roff.hs
@@ -24,10 +24,11 @@ import Prelude
import Data.Char (ord, isAscii)
import Control.Monad.State.Strict
import qualified Data.Map as Map
+import Data.String
import Data.Maybe (fromMaybe, isJust, catMaybes)
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Printf (printf)
import Text.Pandoc.RoffChar (standardEscapes,
characterCodes, combiningAccents)
@@ -97,7 +98,7 @@ escapeString escapeMode (x:xs) =
characterCodeMap :: Map.Map Char String
characterCodeMap = Map.fromList characterCodes
-fontChange :: PandocMonad m => MS m Doc
+fontChange :: (IsString a, PandocMonad m) => MS m (Doc a)
fontChange = do
features <- gets stFontFeatures
inHeader <- gets stInHeader
@@ -110,7 +111,8 @@ fontChange = do
then text "\\f[R]"
else text $ "\\f[" ++ filling ++ "]"
-withFontFeature :: PandocMonad m => Char -> MS m Doc -> MS m Doc
+withFontFeature :: (IsString a, PandocMonad m)
+ => Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature c action = do
modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
begin <- fontChange
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index a9163b3b9..a0e274377 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
@@ -13,9 +14,9 @@
Shared utility functions for pandoc writers.
-}
module Text.Pandoc.Writers.Shared (
- metaToJSON
- , metaToJSON'
- , addVariablesToJSON
+ metaToContext
+ , metaToContext'
+ , addVariablesToContext
, getField
, setField
, resetField
@@ -33,149 +34,118 @@ module Text.Pandoc.Writers.Shared (
, toSubscript
, toSuperscript
, toTableOfContents
+ , endsWithPlain
)
where
import Prelude
+import Safe (lastMay)
import Control.Monad (zipWithM)
-import qualified Data.Aeson as Aeson
-import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
- encode, fromJSON)
+import Data.Aeson (ToJSON (..), encode)
import Data.Char (chr, ord, isSpace)
-import qualified Data.HashMap.Strict as H
import Data.List (groupBy, intersperse, transpose, foldl')
-import Data.Scientific (Scientific)
import qualified Data.Map as M
-import Data.Maybe (isJust)
import qualified Data.Text as T
-import qualified Data.Traversable as Traversable
import qualified Text.Pandoc.Builder as Builder
import Text.Pandoc.Definition
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
-import Text.Pandoc.Shared (stringify, hierarchicalize, Element(..), deNote,
- safeRead)
+import Text.DocLayout
+import Text.Pandoc.Shared (stringify, hierarchicalize, Element(..), deNote)
import Text.Pandoc.Walk (walk)
-import Text.Pandoc.UTF8 (toStringLazy)
+import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.XML (escapeStringForXML)
+import Text.DocTemplates (Context(..), Val(..), TemplateTarget(..),
+ ToContext(..), FromContext(..))
--- | Create JSON value for template from a 'Meta' and an association list
+-- | Create template Context from a 'Meta' and an association list
-- of variables, specified at the command line or in the writer.
-- Variables overwrite metadata fields with the same names.
-- If multiple variables are set with the same name, a list is
-- assigned. Does nothing if 'writerTemplate' is Nothing.
-metaToJSON :: (Monad m, ToJSON a)
- => WriterOptions
- -> ([Block] -> m a)
- -> ([Inline] -> m a)
- -> Meta
- -> m Value
-metaToJSON opts blockWriter inlineWriter meta
- | isJust (writerTemplate opts) =
- addVariablesToJSON opts <$> metaToJSON' blockWriter inlineWriter meta
- | otherwise = return (Object H.empty)
+metaToContext :: (Monad m, TemplateTarget a)
+ => WriterOptions
+ -> ([Block] -> m a)
+ -> ([Inline] -> m a)
+ -> Meta
+ -> m (Context a)
+metaToContext opts blockWriter inlineWriter meta =
+ case writerTemplate opts of
+ Nothing -> return mempty
+ Just _ -> addVariablesToContext opts <$>
+ metaToContext' blockWriter inlineWriter meta
--- | Like 'metaToJSON', but does not include variables and is
+-- | Like 'metaToContext, but does not include variables and is
-- not sensitive to 'writerTemplate'.
-metaToJSON' :: (Monad m, ToJSON a)
+metaToContext' :: (Monad m, TemplateTarget a)
=> ([Block] -> m a)
-> ([Inline] -> m a)
-> Meta
- -> m Value
-metaToJSON' blockWriter inlineWriter (Meta metamap) = do
- renderedMap <- Traversable.mapM
- (metaValueToJSON blockWriter inlineWriter)
- metamap
- return $ M.foldrWithKey defField (Object H.empty) renderedMap
+ -> m (Context a)
+metaToContext' blockWriter inlineWriter (Meta metamap) = do
+ renderedMap <- mapM (metaValueToVal blockWriter inlineWriter) metamap
+ return $ Context
+ $ M.foldrWithKey (\k v x -> M.insert (T.pack k) v x) mempty
+ $ renderedMap
+
+-- | Add variables to a template Context, replacing any existing values.
+addVariablesToContext :: TemplateTarget a
+ => WriterOptions -> Context a -> Context a
+addVariablesToContext opts (Context m1) = Context (m1 `M.union` m2)
+ where
+ m2 = M.fromList $ map (\(k,v)
+ -> (T.pack k,SimpleVal (fromText (T.pack v)))) $
+ ("meta-json", jsonrep) : writerVariables opts
+ jsonrep = UTF8.toStringLazy $ encode $ toJSON m1
--- | Add variables to JSON object, replacing any existing values.
--- Also include @meta-json@, a field containing a string representation
--- of the original JSON object itself, prior to addition of variables.
-addVariablesToJSON :: WriterOptions -> Value -> Value
-addVariablesToJSON opts metadata =
- foldl (\acc (x,y) -> setField x y acc)
- (defField "meta-json" (toStringLazy $ encode metadata) (Object mempty))
- (writerVariables opts)
- `combineMetadata` metadata
- where combineMetadata (Object o1) (Object o2) = Object $ H.union o1 o2
- combineMetadata x _ = x
+metaValueToVal :: (Monad m, TemplateTarget a)
+ => ([Block] -> m a)
+ -> ([Inline] -> m a)
+ -> MetaValue
+ -> m (Val a)
+metaValueToVal blockWriter inlineWriter (MetaMap metamap) =
+ MapVal . Context . M.mapKeys T.pack <$>
+ mapM (metaValueToVal blockWriter inlineWriter) metamap
+metaValueToVal blockWriter inlineWriter (MetaList xs) = ListVal <$>
+ mapM (metaValueToVal blockWriter inlineWriter) xs
+metaValueToVal _ _ (MetaBool True) = return $ SimpleVal $ fromText "true"
+metaValueToVal _ _ (MetaBool False) = return NullVal
+metaValueToVal _ inlineWriter (MetaString s) =
+ SimpleVal <$> inlineWriter (Builder.toList (Builder.text s))
+metaValueToVal blockWriter _ (MetaBlocks bs) = SimpleVal <$> blockWriter bs
+metaValueToVal _ inlineWriter (MetaInlines is) = SimpleVal <$> inlineWriter is
-metaValueToJSON :: (Monad m, ToJSON a)
- => ([Block] -> m a)
- -> ([Inline] -> m a)
- -> MetaValue
- -> m Value
-metaValueToJSON blockWriter inlineWriter (MetaMap metamap) = toJSON <$>
- Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap
-metaValueToJSON blockWriter inlineWriter (MetaList xs) = toJSON <$>
- Traversable.mapM (metaValueToJSON blockWriter inlineWriter) xs
-metaValueToJSON _ _ (MetaBool b) = return $ toJSON b
-metaValueToJSON _ inlineWriter (MetaString s@('0':_:_)) =
- -- don't treat string with leading 0 as string (#5479)
- toJSON <$> inlineWriter (Builder.toList (Builder.text s))
-metaValueToJSON _ inlineWriter (MetaString s) =
- case safeRead s of
- Just (n :: Scientific) -> return $ Aeson.Number n
- Nothing -> toJSON <$> inlineWriter (Builder.toList (Builder.text s))
-metaValueToJSON blockWriter _ (MetaBlocks bs) = toJSON <$> blockWriter bs
-metaValueToJSON blockWriter inlineWriter (MetaInlines [Str s]) =
- metaValueToJSON blockWriter inlineWriter (MetaString s)
-metaValueToJSON _ inlineWriter (MetaInlines is) = toJSON <$> inlineWriter is
--- | Retrieve a field value from a JSON object.
-getField :: FromJSON a
- => String
- -> Value
- -> Maybe a
-getField field (Object hashmap) = do
- result <- H.lookup (T.pack field) hashmap
- case fromJSON result of
- Success x -> return x
- _ -> fail "Could not convert from JSON"
-getField _ _ = fail "Not a JSON object"
+-- | Retrieve a field value from a template context.
+getField :: FromContext a b => String -> Context a -> Maybe b
+getField field (Context m) = M.lookup (T.pack field) m >>= fromVal
-setField :: ToJSON a
- => String
- -> a
- -> Value
- -> Value
--- | Set a field of a JSON object. If the field already has a value,
+-- | Set a field of a template context. If the field already has a value,
-- convert it into a list with the new value appended to the old value(s).
-- This is a utility function to be used in preparing template contexts.
-setField field val (Object hashmap) =
- Object $ H.insertWith combine (T.pack field) (toJSON val) hashmap
- where combine newval oldval =
- case fromJSON oldval of
- Success xs -> toJSON $ xs ++ [newval]
- _ -> toJSON [oldval, newval]
-setField _ _ x = x
+setField :: ToContext a b => String -> b -> Context a -> Context a
+setField field val (Context m) =
+ Context $ M.insertWith combine (T.pack field) (toVal val) m
+ where
+ combine newval (ListVal xs) = ListVal (xs ++ [newval])
+ combine newval x = ListVal [x, newval]
-resetField :: ToJSON a
- => String
- -> a
- -> Value
- -> Value
--- | Reset a field of a JSON object. If the field already has a value,
--- the new value replaces it.
+-- | Reset a field of a template context. If the field already has a
+-- value, the new value replaces it.
-- This is a utility function to be used in preparing template contexts.
-resetField field val (Object hashmap) =
- Object $ H.insert (T.pack field) (toJSON val) hashmap
-resetField _ _ x = x
+resetField :: ToContext a b => String -> b -> Context a -> Context a
+resetField field val (Context m) =
+ Context (M.insert (T.pack field) (toVal val) m)
-defField :: ToJSON a
- => String
- -> a
- -> Value
- -> Value
--- | Set a field of a JSON object if it currently has no value.
+-- | Set a field of a template context if it currently has no value.
-- If it has a value, do nothing.
-- This is a utility function to be used in preparing template contexts.
-defField field val (Object hashmap) =
- Object $ H.insertWith f (T.pack field) (toJSON val) hashmap
- where f _newval oldval = oldval
-defField _ _ x = x
+defField :: ToContext a b => String -> b -> Context a -> Context a
+defField field val (Context m) =
+ Context (M.insertWith f (T.pack field) (toVal val) m)
+ where
+ f _newval oldval = oldval
-- Produce an HTML tag with the given pandoc attributes.
-tagWithAttrs :: String -> Attr -> Doc
+tagWithAttrs :: HasChars a => String -> Attr -> Doc a
tagWithAttrs tag (ident,classes,kvs) = hsep
["<" <> text tag
,if null ident
@@ -236,15 +206,15 @@ unsmartify opts ('\8216':xs) = '\'' : unsmartify opts xs
unsmartify opts (x:xs) = x : unsmartify opts xs
unsmartify _ [] = []
-gridTable :: Monad m
+gridTable :: (Monad m, HasChars a)
=> WriterOptions
- -> (WriterOptions -> [Block] -> m Doc)
+ -> (WriterOptions -> [Block] -> m (Doc a))
-> Bool -- ^ headless
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
- -> m Doc
+ -> m (Doc a)
gridTable opts blocksToDoc headless aligns widths headers rows = do
-- the number of columns will be used in case of even widths
let numcols = maximum (length aligns : length widths :
@@ -299,10 +269,9 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do
| otherwise = handleGivenWidths widths
(widthsInChars, rawHeaders, rawRows) <- handleWidths
let hpipeBlocks blocks = hcat [beg, middle, end]
- where h = maximum (1 : map height blocks)
- sep' = lblock 3 $ vcat (replicate h (text " | "))
- beg = lblock 2 $ vcat (replicate h (text "| "))
- end = lblock 2 $ vcat (replicate h (text " |"))
+ where sep' = vfill " | "
+ beg = vfill "| "
+ end = vfill " |"
middle = chomp $ hcat $ intersperse sep' blocks
let makeRow = hpipeBlocks . zipWith lblock widthsInChars
let head' = makeRow rawHeaders
@@ -427,3 +396,9 @@ elementToListItem opts (Sec lev _nums (ident,_,_) headerText subsecs)
else [Link nullAttr headerText' ('#':ident, "")]
listContents = map (elementToListItem opts) subsecs
elementToListItem _ (Blk _) = []
+
+endsWithPlain :: [Block] -> Bool
+endsWithPlain xs =
+ case lastMay xs of
+ Just (Plain{}) -> True
+ _ -> False
diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs
index e4793e9e7..25062d6fc 100644
--- a/src/Text/Pandoc/Writers/TEI.hs
+++ b/src/Text/Pandoc/Writers/TEI.hs
@@ -23,7 +23,7 @@ import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@@ -36,31 +36,28 @@ writeTEI opts (Pandoc meta blocks) = do
colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- render' :: Doc -> Text
- render' = render colwidth
startLvl = case writerTopLevelDivision opts of
TopLevelPart -> -1
TopLevelChapter -> 0
TopLevelSection -> 1
TopLevelDefault -> 1
- metadata <- metaToJSON opts
- (fmap (render' . vcat) .
+ metadata <- metaToContext opts
+ (fmap vcat .
mapM (elementToTEI opts startLvl) . hierarchicalize)
- (fmap render' . inlinesToTEI opts)
+ (fmap chomp . inlinesToTEI opts)
meta
- main <- (render' . vcat) <$> mapM (elementToTEI opts startLvl) elements
+ main <- vcat <$> mapM (elementToTEI opts startLvl) elements
let context = defField "body" main
- $
- defField "mathml" (case writerHTMLMathMethod opts of
+ $ defField "mathml" (case writerHTMLMathMethod opts of
MathML -> True
_ -> False) metadata
- return $
+ return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Convert an Element to TEI.
-elementToTEI :: PandocMonad m => WriterOptions -> Int -> Element -> m Doc
+elementToTEI :: PandocMonad m => WriterOptions -> Int -> Element -> m (Doc Text)
elementToTEI opts _ (Blk block) = blockToTEI opts block
elementToTEI opts lvl (Sec _ _num attr title elements) = do
-- TEI doesn't allow sections with no content, so insert some if needed
@@ -79,7 +76,7 @@ elementToTEI opts lvl (Sec _ _num attr title elements) = do
inTagsSimple "head" titleContents $$ contents
-- | Convert a list of Pandoc blocks to TEI.
-blocksToTEI :: PandocMonad m => WriterOptions -> [Block] -> m Doc
+blocksToTEI :: PandocMonad m => WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI opts bs = vcat <$> mapM (blockToTEI opts) bs
-- | Auxiliary function to convert Plain block to Para.
@@ -90,13 +87,13 @@ plainToPara x = x
-- | Convert a list of pairs of terms and definitions into a TEI
-- list with labels and items.
deflistItemsToTEI :: PandocMonad m
- => WriterOptions -> [([Inline],[[Block]])] -> m Doc
+ => WriterOptions -> [([Inline],[[Block]])] -> m (Doc Text)
deflistItemsToTEI opts items =
vcat <$> mapM (uncurry (deflistItemToTEI opts)) items
-- | Convert a term and a list of blocks into a TEI varlistentry.
deflistItemToTEI :: PandocMonad m
- => WriterOptions -> [Inline] -> [[Block]] -> m Doc
+ => WriterOptions -> [Inline] -> [[Block]] -> m (Doc Text)
deflistItemToTEI opts term defs = do
term' <- inlinesToTEI opts term
defs' <- blocksToTEI opts $ concatMap (map plainToPara) defs
@@ -104,15 +101,15 @@ deflistItemToTEI opts term defs = do
inTagsIndented "item" defs'
-- | Convert a list of lists of blocks to a list of TEI list items.
-listItemsToTEI :: PandocMonad m => WriterOptions -> [[Block]] -> m Doc
+listItemsToTEI :: PandocMonad m => WriterOptions -> [[Block]] -> m (Doc Text)
listItemsToTEI opts items = vcat <$> mapM (listItemToTEI opts) items
-- | Convert a list of blocks into a TEI list item.
-listItemToTEI :: PandocMonad m => WriterOptions -> [Block] -> m Doc
+listItemToTEI :: PandocMonad m => WriterOptions -> [Block] -> m (Doc Text)
listItemToTEI opts item =
inTagsIndented "item" <$> blocksToTEI opts (map plainToPara item)
-imageToTEI :: PandocMonad m => WriterOptions -> Attr -> String -> m Doc
+imageToTEI :: PandocMonad m => WriterOptions -> Attr -> String -> m (Doc Text)
imageToTEI opts attr src = return $ selfClosingTag "graphic" $
("url", src) : idFromAttr opts attr ++ dims
where
@@ -122,7 +119,7 @@ imageToTEI opts attr src = return $ selfClosingTag "graphic" $
Nothing -> []
-- | Convert a Pandoc block element to TEI.
-blockToTEI :: PandocMonad m => WriterOptions -> Block -> m Doc
+blockToTEI :: PandocMonad m => WriterOptions -> Block -> m (Doc Text)
blockToTEI _ Null = return empty
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
@@ -212,14 +209,14 @@ blockToTEI opts (Table _ _ _ headers rows) = do
tableRowToTEI :: PandocMonad m
=> WriterOptions
-> [[Block]]
- -> m Doc
+ -> m (Doc Text)
tableRowToTEI opts cols =
(inTagsIndented "row" . vcat) <$> mapM (tableItemToTEI opts) cols
tableHeadersToTEI :: PandocMonad m
=> WriterOptions
-> [[Block]]
- -> m Doc
+ -> m (Doc Text)
tableHeadersToTEI opts cols =
(inTags True "row" [("role","label")] . vcat) <$>
mapM (tableItemToTEI opts) cols
@@ -227,16 +224,16 @@ tableHeadersToTEI opts cols =
tableItemToTEI :: PandocMonad m
=> WriterOptions
-> [Block]
- -> m Doc
+ -> m (Doc Text)
tableItemToTEI opts item =
(inTags False "cell" [] . vcat) <$> mapM (blockToTEI opts) item
-- | Convert a list of inline elements to TEI.
-inlinesToTEI :: PandocMonad m => WriterOptions -> [Inline] -> m Doc
+inlinesToTEI :: PandocMonad m => WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI opts lst = hcat <$> mapM (inlineToTEI opts) lst
-- | Convert an inline element to TEI.
-inlineToTEI :: PandocMonad m => WriterOptions -> Inline -> m Doc
+inlineToTEI :: PandocMonad m => WriterOptions -> Inline -> m (Doc Text)
inlineToTEI _ (Str str) = return $ text $ escapeStringForXML str
inlineToTEI opts (Emph lst) =
inTags False "hi" [("rendition","simple:italic")] <$> inlinesToTEI opts lst
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index 6ad932698..5c5eb7fd3 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -21,6 +21,7 @@ import Data.List (maximumBy, transpose)
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text)
+import qualified Data.Text as T
import Network.URI (unEscapeString)
import System.FilePath
import Text.Pandoc.Class (PandocMonad, report)
@@ -29,7 +30,7 @@ import Text.Pandoc.Error
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty
+import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@@ -68,21 +69,17 @@ pandocToTexinfo options (Pandoc meta blocks) = do
let colwidth = if writerWrapText options == WrapAuto
then Just $ writerColumns options
else Nothing
- let render' :: Doc -> Text
- render' = render colwidth
- metadata <- metaToJSON options
- (fmap render' . blockListToTexinfo)
- (fmap render' . inlineListToTexinfo)
+ metadata <- metaToContext options
+ (blockListToTexinfo)
+ (fmap chomp .inlineListToTexinfo)
meta
- main <- blockListToTexinfo blocks
+ body <- blockListToTexinfo blocks
st <- get
- let body = render colwidth main
let context = defField "body" body
$ defField "toc" (writerTableOfContents options)
$ defField "titlepage" titlePage
- $
- defField "strikeout" (stStrikeout st) metadata
- return $
+ $ defField "strikeout" (stStrikeout st) metadata
+ return $ render colwidth $
case writerTemplate options of
Nothing -> body
Just tpl -> renderTemplate tpl context
@@ -100,7 +97,7 @@ stringToTexinfo = escapeStringUsing texinfoEscapes
, ('\x2019', "'")
]
-escapeCommas :: PandocMonad m => TI m Doc -> TI m Doc
+escapeCommas :: PandocMonad m => TI m (Doc Text) -> TI m (Doc Text)
escapeCommas parser = do
oldEscapeComma <- gets stEscapeComma
modify $ \st -> st{ stEscapeComma = True }
@@ -109,13 +106,13 @@ escapeCommas parser = do
return res
-- | Puts contents into Texinfo command.
-inCmd :: String -> Doc -> Doc
+inCmd :: String -> Doc Text -> Doc Text
inCmd cmd contents = char '@' <> text cmd <> braces contents
-- | Convert Pandoc block element to Texinfo.
blockToTexinfo :: PandocMonad m
=> Block -- ^ Block to convert
- -> TI m Doc
+ -> TI m (Doc Text)
blockToTexinfo Null = return empty
@@ -241,7 +238,7 @@ blockToTexinfo (Table caption aligns widths heads rows) = do
colDescriptors <-
if all (== 0) widths
then do -- use longest entry instead of column widths
- cols <- mapM (mapM (liftM (render Nothing . hcat) . mapM blockToTexinfo)) $
+ cols <- mapM (mapM (liftM (T.unpack . render Nothing . hcat) . mapM blockToTexinfo)) $
transpose $ heads : rows
return $ concatMap ((\x -> "{"++x++"} ") . maximumBy (comparing length)) cols
else return $ "@columnfractions " ++ concatMap (printf "%.2f ") widths
@@ -259,20 +256,20 @@ blockToTexinfo (Table caption aligns widths heads rows) = do
tableHeadToTexinfo :: PandocMonad m
=> [Alignment]
-> [[Block]]
- -> TI m Doc
+ -> TI m (Doc Text)
tableHeadToTexinfo = tableAnyRowToTexinfo "@headitem "
tableRowToTexinfo :: PandocMonad m
=> [Alignment]
-> [[Block]]
- -> TI m Doc
+ -> TI m (Doc Text)
tableRowToTexinfo = tableAnyRowToTexinfo "@item "
tableAnyRowToTexinfo :: PandocMonad m
=> String
-> [Alignment]
-> [[Block]]
- -> TI m Doc
+ -> TI m (Doc Text)
tableAnyRowToTexinfo itemtype aligns cols =
zipWithM alignedBlock aligns cols >>=
return . (text itemtype $$) . foldl (\row item -> row $$
@@ -281,7 +278,7 @@ tableAnyRowToTexinfo itemtype aligns cols =
alignedBlock :: PandocMonad m
=> Alignment
-> [Block]
- -> TI m Doc
+ -> TI m (Doc Text)
-- XXX @flushleft and @flushright text won't get word wrapped. Since word
-- wrapping is more important than alignment, we ignore the alignment.
alignedBlock _ = blockListToTexinfo
@@ -298,7 +295,7 @@ alignedBlock _ col = blockListToTexinfo col
-- | Convert Pandoc block elements to Texinfo.
blockListToTexinfo :: PandocMonad m
=> [Block]
- -> TI m Doc
+ -> TI m (Doc Text)
blockListToTexinfo [] = return empty
blockListToTexinfo (x:xs) = do
x' <- blockToTexinfo x
@@ -340,7 +337,7 @@ collectNodes level (x:xs) =
makeMenuLine :: PandocMonad m
=> Block
- -> TI m Doc
+ -> TI m (Doc Text)
makeMenuLine (Header _ _ lst) = do
txt <- inlineListForNode lst
return $ text "* " <> txt <> text "::"
@@ -348,7 +345,7 @@ makeMenuLine _ = throwError $ PandocSomeError "makeMenuLine called with non-Head
listItemToTexinfo :: PandocMonad m
=> [Block]
- -> TI m Doc
+ -> TI m (Doc Text)
listItemToTexinfo lst = do
contents <- blockListToTexinfo lst
let spacer = case reverse lst of
@@ -358,7 +355,7 @@ listItemToTexinfo lst = do
defListItemToTexinfo :: PandocMonad m
=> ([Inline], [[Block]])
- -> TI m Doc
+ -> TI m (Doc Text)
defListItemToTexinfo (term, defs) = do
term' <- inlineListToTexinfo term
let defToTexinfo bs = do d <- blockListToTexinfo bs
@@ -371,13 +368,13 @@ defListItemToTexinfo (term, defs) = do
-- | Convert list of inline elements to Texinfo.
inlineListToTexinfo :: PandocMonad m
=> [Inline] -- ^ Inlines to convert
- -> TI m Doc
+ -> TI m (Doc Text)
inlineListToTexinfo lst = hcat <$> mapM inlineToTexinfo lst
-- | Convert list of inline elements to Texinfo acceptable for a node name.
inlineListForNode :: PandocMonad m
=> [Inline] -- ^ Inlines to convert
- -> TI m Doc
+ -> TI m (Doc Text)
inlineListForNode = return . text . stringToTexinfo .
filter (not . disallowedInNode) . stringify
@@ -388,7 +385,7 @@ disallowedInNode c = c `elem` (".,:()" :: String)
-- | Convert inline element to Texinfo
inlineToTexinfo :: PandocMonad m
=> Inline -- ^ Inline to convert
- -> TI m Doc
+ -> TI m (Doc Text)
inlineToTexinfo (Span _ lst) =
inlineListToTexinfo lst
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
index 3df0a2ec0..88507cc56 100644
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -23,7 +23,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
-import Text.Pandoc.Pretty (render)
+import Text.DocLayout (render)
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@@ -51,13 +51,13 @@ writeTextile opts document =
pandocToTextile :: PandocMonad m
=> WriterOptions -> Pandoc -> TW m Text
pandocToTextile opts (Pandoc meta blocks) = do
- metadata <- metaToJSON opts (blockListToTextile opts)
+ metadata <- metaToContext opts (blockListToTextile opts)
(inlineListToTextile opts) meta
body <- blockListToTextile opts blocks
notes <- gets $ unlines . reverse . stNotes
- let main = pack $ body ++ if null notes then "" else "\n\n" ++ notes
+ let main = body ++ if null notes then "" else "\n\n" ++ notes
let context = defField "body" main metadata
- return $
+ return $ pack $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs
index 04bdbc51b..ed1f04fdf 100644
--- a/src/Text/Pandoc/Writers/ZimWiki.hs
+++ b/src/Text/Pandoc/Writers/ZimWiki.hs
@@ -30,7 +30,7 @@ import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContent
import Text.Pandoc.Shared (escapeURI, isURI, linesToPara, removeFormatting,
substitute, trimr)
import Text.Pandoc.Templates (renderTemplate)
-import Text.Pandoc.Writers.Shared (defField, metaToJSON)
+import Text.Pandoc.Writers.Shared (defField, metaToContext)
data WriterState = WriterState {
stIndent :: String, -- Indent after the marker at the beginning of list items
@@ -50,16 +50,15 @@ writeZimWiki opts document = evalStateT (pandocToZimWiki opts document) def
-- | Return ZimWiki representation of document.
pandocToZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> ZW m Text
pandocToZimWiki opts (Pandoc meta blocks) = do
- metadata <- metaToJSON opts
+ metadata <- metaToContext opts
(fmap trimr . blockListToZimWiki opts)
- (inlineListToZimWiki opts)
+ (fmap trimr . inlineListToZimWiki opts)
meta
- body <- pack <$> blockListToZimWiki opts blocks
+ main <- blockListToZimWiki opts blocks
--let header = "Content-Type: text/x-zim-wiki\nWiki-Format: zim 0.4\n"
- let main = body
let context = defField "body" main
$ defField "toc" (writerTableOfContents opts) metadata
- return $
+ return $ pack $
case writerTemplate opts of
Just tpl -> renderTemplate tpl context
Nothing -> main
diff --git a/src/Text/Pandoc/XML.hs b/src/Text/Pandoc/XML.hs
index 4ebe2ee4b..cf12bf482 100644
--- a/src/Text/Pandoc/XML.hs
+++ b/src/Text/Pandoc/XML.hs
@@ -25,8 +25,9 @@ import Data.Char (isAscii, isSpace, ord)
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup.Entity (lookupEntity, htmlEntities)
-import Text.Pandoc.Pretty
+import Text.DocLayout
import qualified Data.Map as M
+import Data.String
-- | Escape one character as needed for XML.
escapeCharForXML :: Char -> String
@@ -54,14 +55,15 @@ escapeNls (x:xs)
escapeNls [] = []
-- | Return a text object with a string of formatted XML attributes.
-attributeList :: [(String, String)] -> Doc
+attributeList :: IsString a => [(String, String)] -> Doc a
attributeList = hcat . map
(\(a, b) -> text (' ' : escapeStringForXML a ++ "=\"" ++
escapeNls (escapeStringForXML b) ++ "\""))
-- | Put the supplied contents between start and end tags of tagType,
-- with specified attributes and (if specified) indentation.
-inTags:: Bool -> String -> [(String, String)] -> Doc -> Doc
+inTags:: IsString a
+ => Bool -> String -> [(String, String)] -> Doc a -> Doc a
inTags isIndented tagType attribs contents =
let openTag = char '<' <> text tagType <> attributeList attribs <>
char '>'
@@ -71,16 +73,16 @@ inTags isIndented tagType attribs contents =
else openTag <> contents <> closeTag
-- | Return a self-closing tag of tagType with specified attributes
-selfClosingTag :: String -> [(String, String)] -> Doc
+selfClosingTag :: IsString a => String -> [(String, String)] -> Doc a
selfClosingTag tagType attribs =
char '<' <> text tagType <> attributeList attribs <> text " />"
-- | Put the supplied contents between start and end tags of tagType.
-inTagsSimple :: String -> Doc -> Doc
+inTagsSimple :: IsString a => String -> Doc a -> Doc a
inTagsSimple tagType = inTags False tagType []
-- | Put the supplied contents in indented block btw start and end tags.
-inTagsIndented :: String -> Doc -> Doc
+inTagsIndented :: IsString a => String -> Doc a -> Doc a
inTagsIndented tagType = inTags True tagType []
-- | Escape all non-ascii characters using numerical entities.