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.

cabal.project

@@ -13,3 +13,8 @@ source-repository-package
     location: https://github.com/jgm/pandoc-citeproc
     tag: 6d62678ece91bbb4fe4f5a99695006e1d53c3bae
 
+source-repository-package
+    type: git
+    location: https://github.com/jgm/doctemplates
+    tag: 9b2f5d55f4a2b414b10c4b48aaa7d1169e0ba4d7
+

data/templates/default.docbook4

@@ -23,10 +23,10 @@ $if(date)$
 $endif$
   </articleinfo>
 $for(include-before)$
-$include-before$
+  $include-before$
 $endfor$
-$body$
+  $body$
 $for(include-after)$
-$include-after$
+  $include-after$
 $endfor$
 </article>

data/templates/default.docbook5

@@ -28,10 +28,10 @@ $if(date)$
 $endif$
   </info>
 $for(include-before)$
-$include-before$
+  $include-before$
 $endfor$
-$body$
+  $body$
 $for(include-after)$
-$include-after$
+  $include-after$
 $endfor$
 </article>

pandoc.cabal

@@ -411,7 +411,7 @@ library
                  JuicyPixels >= 3.1.6.1 && < 3.4,
                  Glob >= 0.7 && < 0.11,
                  cmark-gfm >= 0.2 && < 0.3,
-                 doctemplates >= 0.3 && < 0.4,
+                 doctemplates >= 0.5 && < 0.6,
                  network-uri >= 2.6 && < 2.7,
                  network >= 2.6,
                  http-client >= 0.4.30 && < 0.7,
@@ -420,6 +420,7 @@ library
                  case-insensitive >= 1.2 && < 1.3,
                  unicode-transforms >= 0.3 && < 0.4,
                  HsYAML >= 0.1.1.1 && < 0.2,
+                 doclayout >= 0.1 && < 0.2,
                  ipynb >= 0.1 && < 0.2,
                  attoparsec >= 0.12 && < 0.14
   if impl(ghc < 8.0)
@@ -465,7 +466,6 @@ library
                    Text.Pandoc.App,
                    Text.Pandoc.Options,
                    Text.Pandoc.Extensions,
-                   Text.Pandoc.Pretty,
                    Text.Pandoc.Shared,
                    Text.Pandoc.MediaBag,
                    Text.Pandoc.Error,

src/Text/Pandoc/Class.hs

@@ -315,18 +315,14 @@ readFileFromDirs (d:ds) f = catchError
     (\_ -> readFileFromDirs ds f)
 
 instance TemplateMonad PandocIO where
-  getPartial fp =
+  getPartial fp = UTF8.toText <$> catchError
-    lift $ UTF8.toText <$>
+                      (readFileStrict fp)
-      catchError (readFileStrict fp)
+                      (\_ -> readDataFile ("templates" </> fp))
-        (\_ -> readDataFile ("templates" </> fp))
 
 instance TemplateMonad PandocPure where
-  getPartial fp =
+  getPartial fp = UTF8.toText <$> catchError
-    lift $ UTF8.toText <$>
+                      (readFileStrict fp)
-      catchError (readFileStrict fp)
+                      (\_ -> readDataFile ("templates" </> fp))
-        (\_ -> readDataFile ("templates" </> fp))
-
---
 
 -- | 'CommonState' represents state that is used by all
 -- instances of 'PandocMonad'.  Normally users should not

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

src/Text/Pandoc/Pretty.hs

@@ -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

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.

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
+
+

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
+  metadata <- metaToContext opts
-      render' = render colwidth
+              (blockListToAsciiDoc opts)
-  metadata <- metaToJSON opts
+              (fmap chomp . inlineListToAsciiDoc opts)
-              (fmap render' . blockListToAsciiDoc opts)
-              (fmap render' . inlineListToAsciiDoc opts)
               meta
-  body <- vcat <$> mapM (elementToAsciiDoc 1 opts) (hierarchicalize blocks)
+  main <- vcat <$> mapM (elementToAsciiDoc 1 opts) (hierarchicalize blocks)
-  let main = render colwidth body
   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
+                    -> ADW m (Doc Text)
-blockListToAsciiDoc opts blocks = cat `fmap` mapM (blockToAsciiDoc opts) blocks
+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])

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
+  metadata <- metaToContext opts
-              (blocksToCommonMark opts)
+              (fmap T.stripEnd . blocksToCommonMark opts)
-              (inlinesToCommonMark opts)
+              (fmap T.stripEnd . inlinesToCommonMark opts)
               meta
   let context =
           -- for backwards compatibility we populate toc

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
+  metadata <- metaToContext options
-      render' = render colwidth
+              blockListToConTeXt
-  metadata <- metaToJSON options
+              (fmap chomp . inlineListToConTeXt)
-              (fmap render' . blockListToConTeXt)
-              (fmap render' . inlineListToConTeXt)
               meta
   body <- mapM (elementToConTeXt options) $ hierarchicalize blocks
-  let main = (render' . vcat) body
+  let main = vcat body
-  let layoutFromMargins = intercalate [','] $ mapMaybe (\(x,y) ->
+  let layoutFromMargins = mconcat $ intersperse ("," :: Doc Text) $
-                                ((x ++ "=") ++) <$> getField y metadata)
+                          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
+                $ maybe id (\l ->
-                $ (case getField "papersize" metadata of
+                     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
+-- change rtl to r2l, ltr to l2r
-toContextDir (Just "rtl") = "r2l"
+toContextDir :: Doc Text -> Doc Text
-toContextDir (Just "ltr") = "l2r"
+toContextDir = fmap (\t -> case t of
-toContextDir _            = ""
+                              "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 '}'
+              then text "\\footnote{" <> nest 2 (chomp contents') <> char '}'
-              else text "\\startbuffer " <> nest 2 contents' <>
+              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

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

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
+  metadata <- metaToContext opts
-                 (fmap (render' . vcat) .
+                 (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 $
+  return $ render colwidth $
-    (if writerPreferAscii opts then toEntities else id) $
+    (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

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
+              $ defField "toc" (writerTableOfContents opts) metadata
-  return $
+  return $ pack $
     case writerTemplate opts of
        Nothing  -> main
        Just tpl -> renderTemplate tpl context

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 $
+                  defField "author-meta" (map T.pack authsMeta) $
-                  maybe id (defField "date-meta") (normalizeDate dateMeta) $
+                  maybe id (defField "date-meta" . T.pack)
-                  defField "pagetitle" (stringifyHTML (docTitle meta)) $
+                    (normalizeDate dateMeta) $
-                  defField "idprefix" (writerIdentifierPrefix opts) $
+                  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) $
+                    ("https://www.w3.org/Talks/Tools/Slidy2" :: Text) $
-                  defField "slideous-url" ("slideous" :: String) $
+                  defField "slideous-url" ("slideous" :: Text) $
-                  defField "revealjs-url" ("reveal.js" :: String) $
+                  defField "revealjs-url" ("reveal.js" :: Text) $
-                  defField "s5-url" ("s5/default" :: String) $
+                  defField "s5-url" ("s5/default" :: Text) $
                   defField "html5" (stHtml5 st)
                   metadata
   return (thebody, context)

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
+  let main = body <> (if isEmpty notes' then empty else blankline <> notes')
-      render' = render colwidth
+  metadata <- metaToContext opts
-  let main = render' $ body <>
+               (blockListToHaddock opts)
-               (if isEmpty notes' then empty else blankline <> notes')
+               (fmap chomp . inlineListToHaddock opts)
-  metadata <- metaToJSON opts
-               (fmap render' . blockListToHaddock opts)
-               (fmap render' . 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
+  return $ hang (writerTabStop opts) start contents $$
-  let contents' = case reverse items of
+           if endsWithPlain items
-                       (BulletList xs:_) | isTightList xs ->
+              then cr
-                            chomp contents <> cr
+              else blankline
-                       (OrderedList _ xs:_) | isTightList xs ->
-                            chomp contents <> cr
-                       _ -> contents
-  return $ hang (writerTabStop opts) start $ contents' <> cr
 
 -- | 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'
+  let contents = (if isTightList defs then vcat else vsep) $
-  return $ nowrap (brackets labelText) <> cr <> contents <> cr
+                 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

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
+      renderMeta f s = fst <$> runStateT (f opts [] s) defaultWriterState
-      render' = render colwidth
+  metadata <- metaToContext opts
-      renderMeta f s = liftM (render' . fst) $ runStateT (f opts [] s) defaultWriterState
-  metadata <- metaToJSON opts
              (renderMeta blocksToICML)
              (renderMeta inlinesToICML)
              meta
-  (doc, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState
+  (main, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState
-  let main    = render' doc
+  let context = defField "body" main
-      context = defField "body" main
+              $ defField "charStyles" (charStylesToDoc st)
-              $ defField "charStyles" (render' $ charStylesToDoc st)
+              $ defField "parStyles"  (parStylesToDoc st)
-              $ defField "parStyles"  (render' $ parStylesToDoc st)
+              $ defField "hyperlinks" (hyperlinksToDoc $ links st) metadata
-              $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) metadata
+  return $ render colwidth $
-  return $
+    (if writerPreferAscii opts then fmap toEntities else id) $
-    (if writerPreferAscii opts then 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

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 $
+  metadata' <- toJSON <$> metaToContext' blockWriter inlineWriter
-                 B.deleteMeta "nbformat" $
+                 (B.deleteMeta "nbformat" $
-                 B.deleteMeta "nbformat_minor" $ jupyterMeta
+                  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

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
+  metadata <- metaToContext opts
-                 (fmap (render' . vcat) .
+                 (fmap vcat .
                           mapM (elementToJATS opts startLvl) .
                             hierarchicalize)
-                 (fmap render' . inlinesToJATS opts)
+                 (fmap chomp . inlinesToJATS opts)
                  meta
-  main <- (render' . vcat) <$>
+  main <- vcat <$> mapM (elementToJATS opts startLvl) elements
-            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 back = vcat backs $$ fns
-  let date = case  getField "date" metadata -- an object
+  let date =
-               `mplus`
+        case getField "date" metadata of
-                   (getField "date" metadata >>= parseDate) of
+          Nothing -> NullVal
-               Nothing  -> mempty
+          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)
+                 in  MapVal $ Context
-                      $ M.insert "month" (show m)
+                      $ M.insert ("year" :: Text) (SimpleVal $ text $ show y)
-                      $ M.insert "day" (show d)
+                      $ 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 $
+  return $ render colwidth $
-    (if writerPreferAscii opts then toEntities else id) $
+    (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

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

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
+  metadata <- metaToContext options
-      render' = render colwidth
+              blockListToLaTeX
-  metadata <- metaToJSON options
+              (fmap chomp . inlineListToLaTeX)
-              (fmap render' . blockListToLaTeX)
-              (fmap render' . 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
+  biblioTitle <- inlineListToLaTeX lastHeader
-  let main = render' $ vsep body
+  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 hasStringValue x = isJust (getField x metadata :: Maybe (Doc Text))
-  let geometryFromMargins = intercalate [','] $ mapMaybe (\(x,y) ->
+  let geometryFromMargins = mconcat $ intersperse ("," :: Doc Text) $
-                                ((x ++ "=") ++) <$> getField y metadata)
+                            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
+  let toPolyObj :: Lang -> Val (Doc Text)
-                              , "options" .= T.pack opts ]
+      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 "title-meta" (T.pack titleMeta) $
-                  defField "author-meta" (intercalate "; " authorsMeta) $
+                  defField "author-meta"
-                  defField "documentclass" documentClass $
+                        (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 (\l -> defField "lang"
-        $ maybe id (defField "babel-lang" . toBabel) mblang
+                      ((text $ renderLang l) :: Doc Text)) mblang
-        $ defField "babel-otherlangs" (map toBabel docLangs)
+        $ maybe id (\l -> defField "babel-lang"
-        $ defField "babel-newcommands" (concatMap (\(poly, babel) ->
+                      ((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
+           ((render Nothing <$> getField "dir" context) ==
-  return $
+               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

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
+  metadata <- metaToContext opts
-              (fmap render' . blockListToMan opts)
+              (blockListToMan opts)
-              (fmap render' . inlineListToMan 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
+              $ defField "pandoc-version" (T.pack pandocVersion) metadata
-  return $
+  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)

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 :: Context (Doc Text) -> Doc Text
-mmdTitleBlock (Object hashmap) =
+mmdTitleBlock (Context hashmap) =
-  vcat $ map go $ sortBy (comparing fst) $ H.toList hashmap
+  vcat $ map go $ sortBy (comparing fst) $ M.toList hashmap
   where go (k,v) =
           case (text (T.unpack k), v) of
-               (k', Array vec)
+               (k', ListVal xs)
-                 | V.null vec     -> empty
+                 | null xs        -> empty
                  | otherwise      -> k' <> ":" <> space <>
-                                      hcat (intersperse "; "
+                                      hcat (intersperse "; " $
-                                           (map fromstr $ V.toList vec))
+                                          catMaybes $ map fromVal xs)
-               (_, String "")  -> empty
+               (k', SimpleVal x)
-               (k', x)         -> k' <> ":" <> space <> nest 2 (fromstr x)
+                      | isEmpty x -> empty
-        fromstr (String s) = text (removeBlankLines $ T.unpack s)
+                      | otherwise -> k' <> ":" <> space <>
-        fromstr (Bool b)   = text (show b)
+                                     nest 2 (chomp (removeBlankLines x))
-        fromstr (Number n) = text (show n)
+               _                  -> empty
-        fromstr _          = empty
+        removeBlankLines BlankLines{} = cr <> text "." <> cr
-        -- blank lines not allowed in MMD metadata - we replace with .
+        removeBlankLines (Concat x y) = removeBlankLines x <>
-        removeBlankLines   = trimr . unlines . map (\x ->
+                                        removeBlankLines y
-                               if all isSpace x then "." else x) . lines
+        removeBlankLines x            = x
-mmdTitleBlock _ = empty
 
-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 :: Context (Doc Text) -> Doc Text
-yamlMetadataBlock v = "---" $$ (jsonToYaml v) $$ "---"
+yamlMetadataBlock v = "---" $$ (contextToYaml v) $$ "---"
 
-jsonToYaml :: Value -> Doc
+contextToYaml :: Context (Doc Text) -> Doc Text
-jsonToYaml (Object hashmap) =
+contextToYaml (Context o) =
-  vcat $ map (\(k,v) ->
+  vcat $ map keyvalToYaml $ sortBy (comparing fst) $ M.toList o
-          case (text (T.unpack k), v, jsonToYaml v) of
+ where
-               (k', Array vec, x)
+  keyvalToYaml (k,v) =
-                 | V.null vec     -> empty
+          case (text (T.unpack k), v) of
-                 | otherwise      -> (k' <> ":") $$ x
+               (k', ListVal vs)
-               (k', Object hm, x)
+                 | null vs        -> empty
-                 | H.null hm      -> k' <> ": {}"
+                 | otherwise      -> (k' <> ":") $$ valToYaml v
-                 | otherwise      -> (k' <> ":") $$ nest 2 x
+               (k', MapVal (Context m))
-               (_, String "", _)  -> empty
+                 | M.null m       -> k' <> ": {}"
-               (k', _, x)         -> k' <> ":" <> space <> hang 2 "" x)
+                 | otherwise      -> (k' <> ":") $$ nest 2 (valToYaml v)
-       $ sortBy (comparing fst) $ H.toList hashmap
+               (_, SimpleVal x)
-jsonToYaml (Array vec) =
+                     | isEmpty x  -> empty
-  vcat $ map (\v -> hang 2 "- " (jsonToYaml v)) $ V.toList vec
+               (_, NullVal)       -> empty
-jsonToYaml (String "") = empty
+               (k', _)            -> k' <> ":" <+> hang 2 "" (valToYaml v)
-jsonToYaml (String s) =
+
-  case T.unpack s of
+valToYaml :: Val (Doc Text) -> Doc Text
-     x | '\n' `elem` x -> hang 2 ("|" <> cr) $ text x
+valToYaml (ListVal xs) =
-       | not (any isPunctuation x) -> text x
+  vcat $ map (\v -> hang 2 "- " (valToYaml v)) xs
-       | otherwise     -> text $ "'" ++ substitute "'" "''" x ++ "'"
+valToYaml (MapVal c) = contextToYaml c
-jsonToYaml (Bool b) = text $ show b
+valToYaml (SimpleVal x)
-jsonToYaml (Number n)
+  | isEmpty x = empty
-  | Scientific.isInteger n = text $ show (floor n :: Integer)
+  | otherwise =
-  | otherwise              = text $ show n
+      if hasNewlines x
-jsonToYaml _ = empty
+         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
+  metadata <- metaToContext'
-      render' = render colwidth . chomp
+               (blockListToMarkdown opts)
-  metadata <- metaToJSON'
+               (inlineListToMarkdown opts)
-               (fmap render' . blockListToMarkdown opts)
-               (fmap render' . blockToMarkdown opts . Plain)
                meta
-  let title' = maybe empty text $ getField "title" metadata
+  let title' = maybe empty id $ getField "title" metadata
-  let authors' = maybe [] (map text) $ getField "author" metadata
+  let authors' = maybe [] id $ getField "author" metadata
-  let date' = maybe empty text $ getField "date" 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
+         then blockToMarkdown opts ( toTableOfContents opts headerBlocks )
-                            ( toTableOfContents opts headerBlocks )
+         else return mempty
-         else return ""
   -- 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))
+                     else defField "titleblock" titleblock)
-               $ addVariablesToJSON opts metadata
+               $ addVariablesToContext opts metadata
-  return $
+  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)
+            let contents = (if isTight then vcat else vsep) $ map
-                                $ vcat d <> cr) defs'
+                            (\d -> hang tabStop (leader <> sps) $ vcat d)
-            let isTight = case defs of
+                            defs'
-                               ((Plain _ : _): _) -> True
-                               _                  -> False
             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 :: Doc Text -> Key
-getKey = toKey . render Nothing
+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 ++ ")"

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.

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
+  metadata <- metaToContext opts
-      render' = render colwidth
+              (blockListToMs opts)
-  metadata <- metaToJSON opts
+              (fmap chomp . inlineListToMs' opts)
-              (fmap render' . blockListToMs opts)
-              (fmap render' . inlineListToMs' opts)
               meta
-  body <- blockListToMs opts blocks
+  main <- blockListToMs opts blocks
-  let main = render' body
   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 "title-meta" (T.pack titleMeta)
-              $ defField "author-meta" (intercalate "; " authorsMeta)
+              $ 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

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
+  metadata <- metaToContext opts
-      render' = render Nothing
+               blockListToMuse
-  metadata <- metaToJSON opts
+               (fmap chomp . inlineListToMuse)
-               (fmap render' . blockListToMuse)
-               (fmap render' . 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

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) =

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)

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) :
+  let attrs = ("text", T.unpack htmlIls) :
-              [("_note", unpack md) | not (null blocks)]
+              [("_note", T.unpack $ T.stripEnd md) | not (null blocks)]
   o <- mapM (elementToOPML opts) rest
   return $ inTags True "outline" attrs $ vcat o

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]
+    WriterState { stNotes          :: [Doc Text]
-                , stTableStyles    :: [Doc]
+                , stTableStyles    :: [Doc Text]
-                , stParaStyles     :: [Doc]
+                , stParaStyles     :: [Doc Text]
-                , stListStyles     :: [(Int, [Doc])]
+                , stListStyles     :: [(Int, [Doc Text])]
-                , stTextStyles     :: Map.Map (Set.Set TextStyle) (String, Doc)
+                , 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
+           m <- metaToContext opts
-                  (fmap render' . blocksToOpenDocument opts)
+                  (blocksToOpenDocument opts)
-                  (fmap render' . inlinesToOpenDocument 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
+              $ defField "automatic-styles" automaticStyles
-  return $
+              $ 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

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
+  metadata <- metaToContext opts
-      render' = render colwidth
+               blockListToOrg
-  metadata <- metaToJSON opts
+               (fmap chomp . inlineListToOrg)
-               (fmap render' . blockListToOrg)
-               (fmap render' . 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)
+        where sep'   = vfill " | "
-              sep'   = lblock 3 $ vcat (replicate h (text " | "))
+              beg    = vfill "| "
-              beg    = lblock 2 $ vcat (replicate h (text "| "))
+              end    = vfill " |"
-              end    = lblock 2 $ vcat (replicate h (text " |"))
               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) =

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
+  metadata <- metaToContext opts
-                (fmap render' . blockListToRST)
+                blockListToRST
-                (fmap (stripEnd . render') . inlineListToRST)
+                (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

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 $
+       Nothing  -> case reverse body of
-                   case reverse body of
                         ('\n':_) -> body
                         _        -> body ++ "\n"
 

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

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
+                       metaToContext
-                     , metaToJSON'
+                     , metaToContext'
-                     , addVariablesToJSON
+                     , 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 (ToJSON (..), encode)
-import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
-                   encode, fromJSON)
 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.DocLayout
-import Text.Pandoc.Shared (stringify, hierarchicalize, Element(..), deNote,
+import Text.Pandoc.Shared (stringify, hierarchicalize, Element(..), deNote)
-                            safeRead)
 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)
+metaToContext :: (Monad m, TemplateTarget a)
-           => WriterOptions
+              => WriterOptions
-           -> ([Block] -> m a)
+              -> ([Block] -> m a)
-           -> ([Inline] -> m a)
+              -> ([Inline] -> m a)
-           -> Meta
+              -> Meta
-           -> m Value
+              -> m (Context a)
-metaToJSON opts blockWriter inlineWriter meta
+metaToContext opts blockWriter inlineWriter meta =
-  | isJust (writerTemplate opts) =
+  case writerTemplate opts of
-    addVariablesToJSON opts <$> metaToJSON' blockWriter inlineWriter meta
+    Nothing -> return mempty
-  | otherwise = return (Object H.empty)
+    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
+           -> m (Context a)
-metaToJSON' blockWriter inlineWriter (Meta metamap) = do
+metaToContext' blockWriter inlineWriter (Meta metamap) = do
-  renderedMap <- Traversable.mapM
+  renderedMap <- mapM (metaValueToVal blockWriter inlineWriter) metamap
-                 (metaValueToJSON blockWriter inlineWriter)
+  return $ Context
-                 metamap
+         $ M.foldrWithKey (\k v x -> M.insert (T.pack k) v x) mempty
-  return $ M.foldrWithKey defField (Object H.empty) renderedMap
+         $ renderedMap
 
--- | Add variables to JSON object, replacing any existing values.
+-- | Add variables to a template Context, replacing any existing values.
--- Also include @meta-json@, a field containing a string representation
+addVariablesToContext :: TemplateTarget a
--- of the original JSON object itself, prior to addition of variables.
+                      => WriterOptions -> Context a -> Context a
-addVariablesToJSON :: WriterOptions -> Value -> Value
+addVariablesToContext opts (Context m1) = Context (m1 `M.union` m2)
-addVariablesToJSON opts metadata =
+ where
-  foldl (\acc (x,y) -> setField x y acc)
+   m2 = M.fromList $ map (\(k,v)
-       (defField "meta-json" (toStringLazy $ encode metadata) (Object mempty))
+                           -> (T.pack k,SimpleVal (fromText (T.pack v)))) $
-       (writerVariables opts)
+           ("meta-json", jsonrep) : writerVariables opts
-    `combineMetadata` metadata
+   jsonrep = UTF8.toStringLazy $ encode $ toJSON m1
-  where combineMetadata (Object o1) (Object o2) = Object $ H.union o1 o2
-        combineMetadata x _                     = x
 
-metaValueToJSON :: (Monad m, ToJSON a)
+metaValueToVal :: (Monad m, TemplateTarget a)
-                => ([Block] -> m a)
+               => ([Block] -> m a)
-                -> ([Inline] -> m a)
+               -> ([Inline] -> m a)
-                -> MetaValue
+               -> MetaValue
-                -> m Value
+               -> m (Val a)
-metaValueToJSON blockWriter inlineWriter (MetaMap metamap) = toJSON <$>
+metaValueToVal blockWriter inlineWriter (MetaMap metamap) =
-  Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap
+  MapVal . Context . M.mapKeys T.pack  <$>
-metaValueToJSON blockWriter inlineWriter (MetaList xs) = toJSON <$>
+    mapM (metaValueToVal blockWriter inlineWriter) metamap
-  Traversable.mapM (metaValueToJSON blockWriter inlineWriter) xs
+metaValueToVal blockWriter inlineWriter (MetaList xs) = ListVal <$>
-metaValueToJSON _ _ (MetaBool b) = return $ toJSON b
+  mapM (metaValueToVal blockWriter inlineWriter) xs
-metaValueToJSON _ inlineWriter (MetaString s@('0':_:_)) =
+metaValueToVal _ _ (MetaBool True) = return $ SimpleVal $ fromText "true"
-   -- don't treat string with leading 0 as string (#5479)
+metaValueToVal _ _ (MetaBool False) = return NullVal
-   toJSON <$> inlineWriter (Builder.toList (Builder.text s))
+metaValueToVal _ inlineWriter (MetaString s) =
-metaValueToJSON _ inlineWriter (MetaString s) =
+   SimpleVal <$> inlineWriter (Builder.toList (Builder.text s))
-  case safeRead s of
+metaValueToVal blockWriter _ (MetaBlocks bs) = SimpleVal <$> blockWriter bs
-     Just (n :: Scientific) -> return $ Aeson.Number n
+metaValueToVal _ inlineWriter (MetaInlines is) = SimpleVal <$> inlineWriter is
-     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"
 
-setField :: ToJSON a
+-- | Retrieve a field value from a template context.
-         => String
+getField   :: FromContext a b => String -> Context a -> Maybe b
-         -> a
+getField field (Context m) = M.lookup (T.pack field) m >>= fromVal
-         -> Value
+
-         -> Value
+-- | Set a field of a template context.  If the field already has a value,
--- | Set a field of a JSON object.  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) =
+setField   :: ToContext a b => String -> b -> Context a -> Context a
-  Object $ H.insertWith combine (T.pack field) (toJSON val) hashmap
+setField field val (Context m) =
-  where combine newval oldval =
+  Context $ M.insertWith combine (T.pack field) (toVal val) m
-          case fromJSON oldval of
+ where
-                Success xs -> toJSON $ xs ++ [newval]
+  combine newval (ListVal xs)   = ListVal (xs ++ [newval])
-                _          -> toJSON [oldval, newval]
+  combine newval x              = ListVal [x, newval]
-setField _ _  x = x
 
-resetField :: ToJSON a
+-- | Reset a field of a template context.  If the field already has a
-           => String
+-- value, the new value replaces it.
-           -> a
-           -> Value
-           -> Value
--- | Reset a field of a JSON object.  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) =
+resetField :: ToContext a b => String -> b -> Context a -> Context a
-  Object $ H.insert (T.pack field) (toJSON val) hashmap
+resetField field val (Context m) =
-resetField _ _  x = x
+  Context (M.insert (T.pack field) (toVal val) m)
 
-defField :: ToJSON a
+-- | Set a field of a template context if it currently has no value.
-         => String
-         -> a
-         -> Value
-         -> Value
--- | Set a field of a JSON object 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) =
+defField   :: ToContext a b => String -> b -> Context a -> Context a
-  Object $ H.insertWith f (T.pack field) (toJSON val) hashmap
+defField field val (Context m) =
-    where f _newval oldval = oldval
+  Context (M.insertWith f (T.pack field) (toVal val) m)
-defField _ _  x = x
+  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)
+        where sep'    = vfill " | "
-              sep'    = lblock 3 $ vcat (replicate h (text " | "))
+              beg     = vfill "| "
-              beg     = lblock 2 $ vcat (replicate h (text "| "))
+              end     = vfill " |"
-              end     = lblock 2 $ vcat (replicate h (text " |"))
               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

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
+  metadata <- metaToContext opts
-                 (fmap (render' . vcat) .
+                 (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

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
+  metadata <- metaToContext options
-      render' = render colwidth
+              (blockListToTexinfo)
-  metadata <- metaToJSON options
+              (fmap chomp .inlineListToTexinfo)
-              (fmap render' . blockListToTexinfo)
-              (fmap render' . 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
-        defField "strikeout" (stStrikeout st) metadata
+  return $ render colwidth $
-  return $
     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

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

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

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.

stack.yaml

@@ -22,7 +22,8 @@ extra-deps:
 - tasty-lua-0.2.0
 - skylighting-core-0.8.2
 - skylighting-0.8.2
-- doctemplates-0.3.0.1
+- doclayout-0.1
+- doctemplates-0.5
 ghc-options:
    "$locals": -Wall -fno-warn-unused-do-bind -Wincomplete-record-updates -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -Wincomplete-uni-patterns -Widentities -Wcpp-undef -fhide-source-paths -Wno-missing-home-modules
 resolver: lts-13.17

test/command/3531.md

@@ -17,5 +17,4 @@ without being broken into pieces.
 A paragraph can span multiple lines
 without being broken into pieces.
 
-
 ```

test/command/3824.md

@@ -10,5 +10,4 @@
 </code>
   * ok
 
-
 ```

test/command/4794.md

@@ -14,5 +14,4 @@
 | text
 |}
 
-
 ```

test/command/5107.md

@@ -8,7 +8,6 @@
     - bar
     * baz
 
-
 ```
 ```
 % pandoc -f muse -t dokuwiki
@@ -20,6 +19,5 @@
     - bar
     - baz
 
-
 ```
 

test/tables.custom

@@ -198,4 +198,3 @@ multiple lines.</td>
 the blank line between rows.</td>
 </tr>
 </table>
-

test/tables.dokuwiki

@@ -44,4 +44,3 @@ Multiline table without column headers:
 
 |  First   |row  |  12.0|Example of a row that spans multiple lines.          |
 |  Second  |row  |   5.0|Here’s another one. Note the blank line between rows.|
-

test/tables.fb2

@@ -13,4 +13,3 @@ multiple lines.</td></tr><tr><td align="center">Second</td><td align="left">row<
 the blank line between rows.</td></tr></table><p><emphasis /></p><p>Table without column headers:</p><table><tr><th align="right" /><th align="left" /><th align="center" /><th align="right" /></tr><tr><td align="right">12</td><td align="left">12</td><td align="center">12</td><td align="right">12</td></tr><tr><td align="right">123</td><td align="left">123</td><td align="center">123</td><td align="right">123</td></tr><tr><td align="right">1</td><td align="left">1</td><td align="center">1</td><td align="right">1</td></tr></table><p><emphasis /></p><p>Multiline table without column headers:</p><table><tr><th align="center" /><th align="left" /><th align="right" /><th align="left" /></tr><tr><td align="center">First</td><td align="left">row</td><td align="right">12.0</td><td align="left">Example of a row that spans
 multiple lines.</td></tr><tr><td align="center">Second</td><td align="left">row</td><td align="right">5.0</td><td align="left">Here’s another one. Note
 the blank line between rows.</td></tr></table><p><emphasis /></p></section></body></FictionBook>
-

test/tables.jira

@@ -41,4 +41,3 @@ Multiline table without column headers:
 
 |First|row|12.0|Example of a row that spans multiple lines.|
 |Second|row|5.0|Here's another one. Note the blank line between rows.|
-

test/tables.mediawiki

@@ -143,4 +143,3 @@ Multiline table without column headers:
 |align="right"| 5.0
 | Here’s another one. Note the blank line between rows.
 |}
-

test/tables.rtf

@@ -357,4 +357,3 @@
 }
 \intbl\row}
 {\pard \ql \f0 \sa180 \li0 \fi0 \par}
-

test/tables.textile

@@ -164,4 +164,3 @@ Multiline table without column headers:
 </tr>
 </tbody>
 </table>
-

test/tables.txt

@@ -72,4 +72,3 @@ Multiline table without column headers:
    Second   row                5.0  Here's another one.  Note
                                     the blank line between rows.
 ----------  ---------  -----------  ---------------------------
-

test/tables.xwiki

@@ -43,4 +43,3 @@ Multiline table without column headers:
 |= |= |= |=
 |First |row |12.0 |Example of a row that spans multiple lines.
 |Second |row |5.0 |Here’s another one. Note the blank line between rows.
-

test/tables.zimwiki

@@ -53,4 +53,3 @@ Multiline table without column headers:
 |:--------:|:----|-----:|-----------------------------------------------------|
 |  First   |row  |  12.0|Example of a row that spans multiple lines.          |
 |  Second  |row  |   5.0|Here’s another one. Note the blank line between rows.|
-

test/writer.custom

@@ -780,4 +780,3 @@ as well as [bracketed text]. <a href="#fnref3">&#8617;</a></p></li>
 <li id="fn4"><p>In quote. <a href="#fnref4">&#8617;</a></p></li>
 <li id="fn5"><p>In list. <a href="#fnref5">&#8617;</a></p></li>
 </ol>
-

test/writer.rst

@@ -619,7 +619,6 @@ LaTeX
 -  Here’s some display math:
 
    .. math:: \frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}
-
 -  Here’s one that has a line break in it: :math:`\alpha + \omega \times x^2`.
 
 These shouldn’t be math:

test/writer.textile

@@ -717,3 +717,4 @@ fn4. In quote.
 
 
 fn5. In list.
+