Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Use new doctemplates, doclayout.

Browse source 
+ 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.
This commit is contained in:
John MacFarlane 2019-08-14 22:11:05 -07:00
parent 8959c44e6a
commit 1ee6e0e087
61 changed files with 3414 additions and 3939 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
cabal.project
View file

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

6
data/templates/default.docbook4
View file

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

6
data/templates/default.docbook5
View file

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

4
pandoc.cabal
View file

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

16
src/Text/Pandoc/Class.hs
View file

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

16
src/Text/Pandoc/PDF.hs
View file

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

543
src/Text/Pandoc/Pretty.hs
View file

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

2
src/Text/Pandoc/Shared.hs
View file

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

7
src/Text/Pandoc/Templates.hs
View file

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

52
src/Text/Pandoc/Writers/AsciiDoc.hs
View file

@ -26,6 +26,7 @@ import Data.Char (isPunctuation, isSpace, toLower, toUpper)
import Data.List (intercalate, intersperse, stripPrefix)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text (Text)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@ -33,7 +34,7 @@ import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, space)
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@ -79,14 +80,11 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON opts
(fmap render' . blockListToAsciiDoc opts)
(fmap render' . inlineListToAsciiDoc opts)
metadata <- metaToContext opts
(blockListToAsciiDoc opts)
(fmap chomp . inlineListToAsciiDoc opts)
meta
body <- vcat <$> mapM (elementToAsciiDoc 1 opts) (hierarchicalize blocks)
let main = render colwidth body
main <- vcat <$> mapM (elementToAsciiDoc 1 opts) (hierarchicalize blocks)
st <- get
let context = defField "body" main
$ defField "toc"
@ -94,13 +92,13 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do
isJust (writerTemplate opts))
$ defField "math" (hasMath st)
$ defField "titleblock" titleblock metadata
return $
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
elementToAsciiDoc :: PandocMonad m
=> Int -> WriterOptions -> Element -> ADW m Doc
=> Int -> WriterOptions -> Element -> ADW m (Doc Text)
elementToAsciiDoc _ opts (Blk b) = blockToAsciiDoc opts b
elementToAsciiDoc nestlevel opts (Sec _lvl _num attr label children) = do
hdr <- blockToAsciiDoc opts (Header nestlevel attr label)
@ -137,7 +135,7 @@ needsEscaping s = beginsWithOrderedListMarker s || isBracketed s
blockToAsciiDoc :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
-> ADW m Doc
-> ADW m (Doc Text)
blockToAsciiDoc _ Null = return empty
blockToAsciiDoc opts (Plain inlines) = do
contents <- inlineListToAsciiDoc opts inlines
@ -147,7 +145,7 @@ blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) =
blockToAsciiDoc opts (Para inlines) = do
contents <- inlineListToAsciiDoc opts inlines
-- escape if para starts with ordered list marker
let esc = if needsEscaping (render Nothing contents)
let esc = if needsEscaping (T.unpack $ render Nothing contents)
then text "{empty}"
else empty
return $ esc <> contents <> blankline
@ -257,7 +255,7 @@ blockToAsciiDoc opts (BulletList items) = do
modify $ \st -> st{ inList = True }
contents <- mapM (bulletListItemToAsciiDoc opts) items
modify $ \st -> st{ inList = inlist }
return $ cat contents <> blankline
return $ mconcat contents <> blankline
blockToAsciiDoc opts (OrderedList (start, sty, _delim) items) = do
let listStyle = case sty of
DefaultStyle -> []
@ -272,13 +270,13 @@ blockToAsciiDoc opts (OrderedList (start, sty, _delim) items) = do
modify $ \st -> st{ inList = True }
contents <- mapM (orderedListItemToAsciiDoc opts) items
modify $ \st -> st{ inList = inlist }
return $ listoptions $$ cat contents <> blankline
return $ listoptions $$ mconcat contents <> blankline
blockToAsciiDoc opts (DefinitionList items) = do
inlist <- gets inList
modify $ \st -> st{ inList = True }
contents <- mapM (definitionListItemToAsciiDoc opts) items
modify $ \st -> st{ inList = inlist }
return $ cat contents <> blankline
return $ mconcat contents <> blankline
blockToAsciiDoc opts (Div (ident,classes,_) bs) = do
let identifier = if null ident then empty else "[[" <> text ident <> "]]"
let admonitions = ["attention","caution","danger","error","hint",
@ -305,7 +303,7 @@ blockToAsciiDoc opts (Div (ident,classes,_) bs) = do
-- | Convert bullet list item (list of blocks) to asciidoc.
bulletListItemToAsciiDoc :: PandocMonad m
=> WriterOptions -> [Block] -> ADW m Doc
=> WriterOptions -> [Block] -> ADW m (Doc Text)
bulletListItemToAsciiDoc opts blocks = do
lev <- gets bulletListLevel
modify $ \s -> s{ bulletListLevel = lev + 1 }
@ -315,7 +313,8 @@ bulletListItemToAsciiDoc opts blocks = do
return $ marker <> text " " <> listBegin blocks <>
contents <> cr
addBlock :: PandocMonad m => WriterOptions -> Doc -> Block -> ADW m Doc
addBlock :: PandocMonad m
=> WriterOptions -> Doc Text -> Block -> ADW m (Doc Text)
addBlock opts d b = do
x <- chomp <$> blockToAsciiDoc opts b
return $
@ -328,7 +327,7 @@ addBlock opts d b = do
Plain{} | isEmpty d -> x
_ -> d <> cr <> text "+" <> cr <> x
listBegin :: [Block] -> Doc
listBegin :: [Block] -> Doc Text
listBegin blocks =
case blocks of
Para (Math DisplayMath _:_) : _ -> "{blank}"
@ -342,7 +341,7 @@ listBegin blocks =
orderedListItemToAsciiDoc :: PandocMonad m
=> WriterOptions -- ^ options
-> [Block] -- ^ list item (list of blocks)
-> ADW m Doc
-> ADW m (Doc Text)
orderedListItemToAsciiDoc opts blocks = do
lev <- gets orderedListLevel
modify $ \s -> s{ orderedListLevel = lev + 1 }
@ -355,7 +354,7 @@ orderedListItemToAsciiDoc opts blocks = do
definitionListItemToAsciiDoc :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> ADW m Doc
-> ADW m (Doc Text)
definitionListItemToAsciiDoc opts (label, defs) = do
labelText <- inlineListToAsciiDoc opts label
marker <- gets defListMarker
@ -363,7 +362,7 @@ definitionListItemToAsciiDoc opts (label, defs) = do
then modify (\st -> st{ defListMarker = ";;"})
else modify (\st -> st{ defListMarker = "::"})
let divider = cr <> text "+" <> cr
let defsToAsciiDoc :: PandocMonad m => [Block] -> ADW m Doc
let defsToAsciiDoc :: PandocMonad m => [Block] -> ADW m (Doc Text)
defsToAsciiDoc ds = (vcat . intersperse divider . map chomp)
`fmap` mapM (blockToAsciiDoc opts) ds
defs' <- mapM defsToAsciiDoc defs
@ -375,13 +374,14 @@ definitionListItemToAsciiDoc opts (label, defs) = do
blockListToAsciiDoc :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
-> ADW m Doc
blockListToAsciiDoc opts blocks = cat `fmap` mapM (blockToAsciiDoc opts) blocks
-> ADW m (Doc Text)
blockListToAsciiDoc opts blocks =
mconcat `fmap` mapM (blockToAsciiDoc opts) blocks
data SpacyLocation = End | Start
-- | Convert list of Pandoc inline elements to asciidoc.
inlineListToAsciiDoc :: PandocMonad m => WriterOptions -> [Inline] -> ADW m Doc
inlineListToAsciiDoc :: PandocMonad m => WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc opts lst = do
oldIntraword <- gets intraword
setIntraword False
@ -424,7 +424,7 @@ withIntraword :: PandocMonad m => ADW m a -> ADW m a
withIntraword p = setIntraword True *> p <* setIntraword False
-- | Convert Pandoc inline element to asciidoc.
inlineToAsciiDoc :: PandocMonad m => WriterOptions -> Inline -> ADW m Doc
inlineToAsciiDoc :: PandocMonad m => WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc opts (Emph [Strong xs]) =
inlineToAsciiDoc opts (Strong [Emph xs]) -- see #5565
inlineToAsciiDoc opts (Emph lst) = do
@ -529,7 +529,7 @@ inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do
dimList = showDim Width ++ showDim Height
dims = if null dimList
then empty
else "," <> cat (intersperse "," dimList)
else "," <> mconcat (intersperse "," dimList)
return $ "image:" <> text src <> "[" <> linktext <> linktitle <> dims <> "]"
inlineToAsciiDoc opts (Note [Para inlines]) =
inlineToAsciiDoc opts (Note [Plain inlines])

6
src/Text/Pandoc/Writers/CommonMark.hs
View file

@ -49,9 +49,9 @@ writeCommonMark opts (Pandoc meta blocks) = do
then []
else [OrderedList (1, Decimal, Period) $ reverse notes]
main <- blocksToCommonMark opts (blocks' ++ notes')
metadata <- metaToJSON opts
(blocksToCommonMark opts)
(inlinesToCommonMark opts)
metadata <- metaToContext opts
(fmap T.stripEnd . blocksToCommonMark opts)
(fmap T.stripEnd . inlinesToCommonMark opts)
meta
let context =
-- for backwards compatibility we populate toc

83
src/Text/Pandoc/Writers/ConTeXt.hs
View file

@ -19,6 +19,7 @@ import Data.Char (ord, isDigit, toLower)
import Data.List (intercalate, intersperse)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (unEscapeString)
import Text.Pandoc.BCP47
import Text.Pandoc.Class (PandocMonad, report, toLang)
@ -26,7 +27,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Walk (query)
@ -60,16 +61,15 @@ pandocToConTeXt options (Pandoc meta blocks) = do
let colwidth = if writerWrapText options == WrapAuto
then Just $ writerColumns options
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON options
(fmap render' . blockListToConTeXt)
(fmap render' . inlineListToConTeXt)
metadata <- metaToContext options
blockListToConTeXt
(fmap chomp . inlineListToConTeXt)
meta
body <- mapM (elementToConTeXt options) $ hierarchicalize blocks
let main = (render' . vcat) body
let layoutFromMargins = intercalate [','] $ mapMaybe (\(x,y) ->
((x ++ "=") ++) <$> getField y metadata)
let main = vcat body
let layoutFromMargins = mconcat $ intersperse ("," :: Doc Text) $
mapMaybe (\(x,y) ->
((x <> "=") <>) <$> getField y metadata)
[("leftmargin","margin-left")
,("rightmargin","margin-right")
,("top","margin-top")
@ -77,7 +77,8 @@ pandocToConTeXt options (Pandoc meta blocks) = do
]
mblang <- fromBCP47 (getLang options meta)
let context = defField "toc" (writerTableOfContents options)
$ defField "placelist" (intercalate ("," :: String) $
$ defField "placelist"
(mconcat . intersperse ("," :: Doc Text) $
take (writerTOCDepth options +
case writerTopLevelDivision options of
TopLevelPart -> 0
@ -88,26 +89,30 @@ pandocToConTeXt options (Pandoc meta blocks) = do
$ defField "body" main
$ defField "layout" layoutFromMargins
$ defField "number-sections" (writerNumberSections options)
$ maybe id (defField "context-lang") mblang
$ (case getField "papersize" metadata of
$ maybe id (\l ->
defField "context-lang" (text l :: Doc Text)) mblang
$ (case T.unpack . render Nothing <$>
getField "papersize" metadata of
Just (('a':d:ds) :: String)
| all isDigit (d:ds) -> resetField "papersize"
(('A':d:ds) :: String)
(T.pack ('A':d:ds))
_ -> id)
$ (case toLower <$> lookupMetaString "pdfa" meta of
"true" -> resetField "pdfa" ("1b:2005" :: String)
"true" -> resetField "pdfa" (T.pack "1b:2005")
_ -> id) metadata
let context' = defField "context-dir" (toContextDir
let context' = defField "context-dir" (maybe mempty toContextDir
$ getField "dir" context) context
return $
return $ render colwidth $
case writerTemplate options of
Nothing -> main
Just tpl -> renderTemplate tpl context'
toContextDir :: Maybe String -> String
toContextDir (Just "rtl") = "r2l"
toContextDir (Just "ltr") = "l2r"
toContextDir _ = ""
-- change rtl to r2l, ltr to l2r
toContextDir :: Doc Text -> Doc Text
toContextDir = fmap (\t -> case t of
"ltr" -> "l2r"
"rtl" -> "r2l"
_ -> t)
-- | escape things as needed for ConTeXt
escapeCharForConTeXt :: WriterOptions -> Char -> String
@ -143,7 +148,7 @@ toLabel z = concatMap go z
| otherwise = [x]
-- | Convert Elements to ConTeXt
elementToConTeXt :: PandocMonad m => WriterOptions -> Element -> WM m Doc
elementToConTeXt :: PandocMonad m => WriterOptions -> Element -> WM m (Doc Text)
elementToConTeXt _ (Blk block) = blockToConTeXt block
elementToConTeXt opts (Sec level _ attr title' elements) = do
header' <- sectionHeader attr level title'
@ -152,7 +157,7 @@ elementToConTeXt opts (Sec level _ attr title' elements) = do
return $ header' $$ vcat innerContents $$ footer'
-- | Convert Pandoc block element to ConTeXt.
blockToConTeXt :: PandocMonad m => Block -> WM m Doc
blockToConTeXt :: PandocMonad m => Block -> WM m (Doc Text)
blockToConTeXt Null = return empty
blockToConTeXt (Plain lst) = inlineListToConTeXt lst
-- title beginning with fig: indicates that the image is a figure
@ -258,7 +263,8 @@ blockToConTeXt (Table caption aligns widths heads rows) = do
else "title=" <> braces captionText
) $$ body $$ "\\stopplacetable" <> blankline
tableToConTeXt :: PandocMonad m => Tabl -> Doc -> [Doc] -> WM m Doc
tableToConTeXt :: PandocMonad m
=> Tabl -> Doc Text -> [Doc Text] -> WM m (Doc Text)
tableToConTeXt Xtb heads rows =
return $ "\\startxtable" $$
(if isEmpty heads
@ -280,7 +286,7 @@ tableToConTeXt Ntb heads rows =
"\\startTABLEfoot" $$ last rows $$ "\\stopTABLEfoot") $$
"\\stopTABLE"
tableRowToConTeXt :: PandocMonad m => Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m Doc
tableRowToConTeXt :: PandocMonad m => Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text)
tableRowToConTeXt Xtb aligns widths cols = do
cells <- mapM (tableColToConTeXt Xtb) $ zip3 aligns widths cols
return $ "\\startxrow" $$ vcat cells $$ "\\stopxrow"
@ -288,7 +294,7 @@ tableRowToConTeXt Ntb aligns widths cols = do
cells <- mapM (tableColToConTeXt Ntb) $ zip3 aligns widths cols
return $ vcat cells $$ "\\NC\\NR"
tableColToConTeXt :: PandocMonad m => Tabl -> (Alignment, Double, [Block]) -> WM m Doc
tableColToConTeXt :: PandocMonad m => Tabl -> (Alignment, Double, [Block]) -> WM m (Doc Text)
tableColToConTeXt tabl (align, width, blocks) = do
cellContents <- blockListToConTeXt blocks
let colwidth = if width == 0
@ -301,23 +307,24 @@ tableColToConTeXt tabl (align, width, blocks) = do
where keys = hcat $ intersperse "," $ filter (not . isEmpty) [halign, colwidth]
tableCellToConTeXt tabl options cellContents
tableCellToConTeXt :: PandocMonad m => Tabl -> Doc -> Doc -> WM m Doc
tableCellToConTeXt :: PandocMonad m
=> Tabl -> Doc Text -> Doc Text -> WM m (Doc Text)
tableCellToConTeXt Xtb options cellContents =
return $ "\\startxcell" <> options <> cellContents <> " \\stopxcell"
tableCellToConTeXt Ntb options cellContents =
return $ "\\NC" <> options <> cellContents
alignToConTeXt :: Alignment -> Doc
alignToConTeXt :: Alignment -> Doc Text
alignToConTeXt align = case align of
AlignLeft -> "align=right"
AlignRight -> "align=left"
AlignCenter -> "align=middle"
AlignDefault -> empty
listItemToConTeXt :: PandocMonad m => [Block] -> WM m Doc
listItemToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt list = (("\\item" $$) . nest 2) <$> blockListToConTeXt list
defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m Doc
defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m (Doc Text)
defListItemToConTeXt (term, defs) = do
term' <- inlineListToConTeXt term
def' <- liftM vsep $ mapM blockListToConTeXt defs
@ -325,13 +332,13 @@ defListItemToConTeXt (term, defs) = do
"\\stopdescription" <> blankline
-- | Convert list of block elements to ConTeXt.
blockListToConTeXt :: PandocMonad m => [Block] -> WM m Doc
blockListToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt lst = liftM vcat $ mapM blockToConTeXt lst
-- | Convert list of inline elements to ConTeXt.
inlineListToConTeXt :: PandocMonad m
=> [Inline] -- ^ Inlines to convert
-> WM m Doc
-> WM m (Doc Text)
inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt $ addStruts lst
-- We add a \strut after a line break that precedes a space,
-- or the space gets swallowed
@ -347,7 +354,7 @@ inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt $ addStruts lst
-- | Convert inline element to ConTeXt
inlineToConTeXt :: PandocMonad m
=> Inline -- ^ Inline to convert
-> WM m Doc
-> WM m (Doc Text)
inlineToConTeXt (Emph lst) = do
contents <- inlineListToConTeXt lst
return $ braces $ "\\em " <> contents
@ -435,7 +442,7 @@ inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do
dimList = showDim Width ++ showDim Height
dims = if null dimList
then empty
else brackets $ cat (intersperse "," dimList)
else brackets $ mconcat (intersperse "," dimList)
clas = if null cls
then empty
else brackets $ text $ toLabel $ head cls
@ -454,8 +461,8 @@ inlineToConTeXt (Note contents) = do
codeBlock _ = []
let codeBlocks = query codeBlock contents
return $ if null codeBlocks
then text "\\footnote{" <> nest 2 contents' <> char '}'
else text "\\startbuffer " <> nest 2 contents' <>
then text "\\footnote{" <> nest 2 (chomp contents') <> char '}'
else text "\\startbuffer " <> nest 2 (chomp contents') <>
text "\\stopbuffer\\footnote{\\getbuffer}"
inlineToConTeXt (Span (_,_,kvs) ils) = do
mblang <- fromBCP47 (lookup "lang" kvs)
@ -474,7 +481,7 @@ sectionHeader :: PandocMonad m
=> Attr
-> Int
-> [Inline]
-> WM m Doc
-> WM m (Doc Text)
sectionHeader (ident,classes,kvs) hdrLevel lst = do
opts <- gets stOptions
contents <- inlineListToConTeXt lst
@ -495,7 +502,7 @@ sectionHeader (ident,classes,kvs) hdrLevel lst = do
return $ starter <> levelText <> options <> blankline
-- | Craft the section footer
sectionFooter :: PandocMonad m => Attr -> Int -> WM m Doc
sectionFooter :: PandocMonad m => Attr -> Int -> WM m (Doc Text)
sectionFooter attr hdrLevel = do
opts <- gets stOptions
levelText <- sectionLevelToText opts attr hdrLevel
@ -504,7 +511,7 @@ sectionFooter attr hdrLevel = do
else empty
-- | Generate a textual representation of the section level
sectionLevelToText :: PandocMonad m => WriterOptions -> Attr -> Int -> WM m Doc
sectionLevelToText :: PandocMonad m => WriterOptions -> Attr -> Int -> WM m (Doc Text)
sectionLevelToText opts (_,classes,_) hdrLevel = do
let level' = case writerTopLevelDivision opts of
TopLevelPart -> hdrLevel - 2

8
src/Text/Pandoc/Writers/Custom.hs
View file

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

48
src/Text/Pandoc/Writers/Docbook.hs
View file

@ -20,6 +20,7 @@ import Data.Generics (everywhere, mkT)
import Data.List (isPrefixOf, stripPrefix)
import Data.Monoid (Any (..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@ -27,12 +28,12 @@ import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.XML.Light as Xml
@ -45,7 +46,7 @@ type DB = ReaderT DocBookVersion
-- | Convert list of authors to a docbook <author> section
authorToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m B.Inlines
authorToDocbook opts name' = do
name <- render Nothing <$> inlinesToDocbook opts name'
name <- T.unpack . render Nothing <$> inlinesToDocbook opts name'
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
@ -81,8 +82,6 @@ writeDocbook opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
-- The numbering here follows LaTeX's internal numbering
let startLvl = case writerTopLevelDivision opts of
TopLevelPart -> -1
@ -91,26 +90,25 @@ writeDocbook opts (Pandoc meta blocks) = do
TopLevelDefault -> 1
auths' <- mapM (authorToDocbook opts) $ docAuthors meta
let meta' = B.setMeta "author" auths' meta
metadata <- metaToJSON opts
(fmap (render' . vcat) .
metadata <- metaToContext opts
(fmap vcat .
mapM (elementToDocbook opts startLvl) .
hierarchicalize)
(fmap render' . inlinesToDocbook opts)
(inlinesToDocbook opts)
meta'
main <- (render' . vcat) <$> mapM (elementToDocbook opts startLvl) elements
main <- vcat <$> mapM (elementToDocbook opts startLvl) elements
let context = defField "body" main
$
defField "mathml" (case writerHTMLMathMethod opts of
$ defField "mathml" (case writerHTMLMathMethod opts of
MathML -> True
_ -> False) metadata
return $
(if writerPreferAscii opts then toEntities else id) $
return $ render colwidth $
(if writerPreferAscii opts then fmap toEntities else id) $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Convert an Element to Docbook.
elementToDocbook :: PandocMonad m => WriterOptions -> Int -> Element -> DB m Doc
elementToDocbook :: PandocMonad m => WriterOptions -> Int -> Element -> DB m (Doc Text)
elementToDocbook opts _ (Blk block) = blockToDocbook opts block
elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) = do
version <- ask
@ -138,7 +136,7 @@ elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) = do
inTagsSimple "title" title' $$ vcat contents
-- | Convert a list of Pandoc blocks to Docbook.
blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m Doc
blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook opts = fmap vcat . mapM (blockToDocbook opts)
-- | Auxiliary function to convert Plain block to Para.
@ -149,13 +147,13 @@ plainToPara x = x
-- | Convert a list of pairs of terms and definitions into a list of
-- Docbook varlistentrys.
deflistItemsToDocbook :: PandocMonad m
=> WriterOptions -> [([Inline],[[Block]])] -> DB m Doc
=> WriterOptions -> [([Inline],[[Block]])] -> DB m (Doc Text)
deflistItemsToDocbook opts items =
vcat <$> mapM (uncurry (deflistItemToDocbook opts)) items
-- | Convert a term and a list of blocks into a Docbook varlistentry.
deflistItemToDocbook :: PandocMonad m
=> WriterOptions -> [Inline] -> [[Block]] -> DB m Doc
=> WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocbook opts term defs = do
term' <- inlinesToDocbook opts term
def' <- blocksToDocbook opts $ concatMap (map plainToPara) defs
@ -164,15 +162,15 @@ deflistItemToDocbook opts term defs = do
inTagsIndented "listitem" def'
-- | Convert a list of lists of blocks to a list of Docbook list items.
listItemsToDocbook :: PandocMonad m => WriterOptions -> [[Block]] -> DB m Doc
listItemsToDocbook :: PandocMonad m => WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook opts items = vcat <$> mapM (listItemToDocbook opts) items
-- | Convert a list of blocks into a Docbook list item.
listItemToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m Doc
listItemToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocbook opts item =
inTagsIndented "listitem" <$> blocksToDocbook opts (map plainToPara item)
imageToDocbook :: WriterOptions -> Attr -> String -> Doc
imageToDocbook :: WriterOptions -> Attr -> String -> Doc Text
imageToDocbook _ attr src = selfClosingTag "imagedata" $
("fileref", src) : idAndRole attr ++ dims
where
@ -182,7 +180,7 @@ imageToDocbook _ attr src = selfClosingTag "imagedata" $
Nothing -> []
-- | Convert a Pandoc block element to Docbook.
blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m Doc
blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook _ Null = return empty
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
@ -312,23 +310,23 @@ alignmentToString alignment = case alignment of
tableRowToDocbook :: PandocMonad m
=> WriterOptions
-> [[Block]]
-> DB m Doc
-> DB m (Doc Text)
tableRowToDocbook opts cols =
(inTagsIndented "row" . vcat) <$> mapM (tableItemToDocbook opts) cols
tableItemToDocbook :: PandocMonad m
=> WriterOptions
-> [Block]
-> DB m Doc
-> DB m (Doc Text)
tableItemToDocbook opts item =
(inTags True "entry" [] . vcat) <$> mapM (blockToDocbook opts) item
-- | Convert a list of inline elements to Docbook.
inlinesToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m Doc
inlinesToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook opts lst = hcat <$> mapM (inlineToDocbook opts) lst
-- | Convert an inline element to Docbook.
inlineToDocbook :: PandocMonad m => WriterOptions -> Inline -> DB m Doc
inlineToDocbook :: PandocMonad m => WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook _ (Str str) = return $ text $ escapeStringForXML str
inlineToDocbook opts (Emph lst) =
inTagsSimple "emphasis" <$> inlinesToDocbook opts lst

12
src/Text/Pandoc/Writers/DokuWiki.hs
View file

@ -37,7 +37,7 @@ import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContent
import Text.Pandoc.Shared (camelCaseToHyphenated, escapeURI, isURI, linesToPara,
removeFormatting, substitute, trimr)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared (defField, metaToJSON)
import Text.Pandoc.Writers.Shared (defField, metaToContext)
data WriterState = WriterState {
}
@ -70,15 +70,15 @@ runDokuWiki = flip evalStateT def . flip runReaderT def
pandocToDokuWiki :: PandocMonad m
=> WriterOptions -> Pandoc -> DokuWiki m Text
pandocToDokuWiki opts (Pandoc meta blocks) = do
metadata <- metaToJSON opts
metadata <- metaToContext opts
(fmap trimr . blockListToDokuWiki opts)
(inlineListToDokuWiki opts)
(fmap trimr . inlineListToDokuWiki opts)
meta
body <- blockListToDokuWiki opts blocks
let main = pack body
let main = body
let context = defField "body" main
$ defField "toc" (writerTableOfContents opts) metadata
return $
$ defField "toc" (writerTableOfContents opts) metadata
return $ pack $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context

39
src/Text/Pandoc/Writers/HTML.hs
View file

@ -36,6 +36,7 @@ import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
import qualified Data.Set as Set
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Network.HTTP (urlEncode)
import Network.URI (URI (..), parseURIReference)
@ -53,7 +54,8 @@ import Text.Pandoc.ImageSize
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Slides
import Text.Pandoc.Templates
import Text.Pandoc.Templates (renderTemplate)
import Text.DocTemplates (Context(..))
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
@ -71,7 +73,6 @@ import qualified Text.Blaze.Html5 as H5
import qualified Text.Blaze.Html5.Attributes as A5
#endif
import Control.Monad.Except (throwError)
import Data.Aeson (Value)
import System.FilePath (takeBaseName)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Text.Blaze.XHtml1.Transitional as H
@ -215,17 +216,17 @@ writeHtmlString' st opts d = do
Nothing -> return $ renderHtml' body
Just tpl -> do
-- warn if empty lang
when (isNothing (getField "lang" context :: Maybe String)) $
when (isNothing (getField "lang" context :: Maybe Text)) $
report NoLangSpecified
-- check for empty pagetitle
context' <-
case getField "pagetitle" context of
Just (s :: String) | not (null s) -> return context
Just (s :: Text) | not (T.null s) -> return context
_ -> do
let fallback = fromMaybe "Untitled" $ takeBaseName <$>
let fallback = maybe "Untitled" takeBaseName $
lookup "sourcefile" (writerVariables opts)
report $ NoTitleElement fallback
return $ resetField "pagetitle" fallback context
return $ resetField "pagetitle" (T.pack fallback) context
return $ renderTemplate tpl
(defField "body" (renderHtml' body) context')
@ -244,9 +245,9 @@ writeHtml' st opts d =
pandocToHtml :: PandocMonad m
=> WriterOptions
-> Pandoc
-> StateT WriterState m (Html, Value)
-> StateT WriterState m (Html, Context Text)
pandocToHtml opts (Pandoc meta blocks) = do
metadata <- metaToJSON opts
metadata <- metaToContext opts
(fmap renderHtml' . blockListToHtml opts)
(fmap renderHtml' . inlineListToHtml opts)
meta
@ -298,7 +299,7 @@ pandocToHtml opts (Pandoc meta blocks) = do
let context = (if stHighlighting st
then case writerHighlightStyle opts of
Just sty -> defField "highlighting-css"
(styleToCss sty)
(T.pack $ styleToCss sty)
Nothing -> id
else id) $
(if stMath st
@ -307,7 +308,7 @@ pandocToHtml opts (Pandoc meta blocks) = do
(case writerHTMLMathMethod opts of
MathJax u -> defField "mathjax" True .
defField "mathjaxurl"
(takeWhile (/='?') u)
(T.pack $ takeWhile (/='?') u)
_ -> defField "mathjax" False) $
defField "quotes" (stQuotes st) $
-- for backwards compatibility we populate toc
@ -315,16 +316,18 @@ pandocToHtml opts (Pandoc meta blocks) = do
-- boolean:
maybe id (defField "toc") toc $
maybe id (defField "table-of-contents") toc $
defField "author-meta" authsMeta $
maybe id (defField "date-meta") (normalizeDate dateMeta) $
defField "pagetitle" (stringifyHTML (docTitle meta)) $
defField "idprefix" (writerIdentifierPrefix opts) $
defField "author-meta" (map T.pack authsMeta) $
maybe id (defField "date-meta" . T.pack)
(normalizeDate dateMeta) $
defField "pagetitle"
(T.pack . stringifyHTML . docTitle $ meta) $
defField "idprefix" (T.pack $ writerIdentifierPrefix opts) $
-- these should maybe be set in pandoc.hs
defField "slidy-url"
("https://www.w3.org/Talks/Tools/Slidy2" :: String) $
defField "slideous-url" ("slideous" :: String) $
defField "revealjs-url" ("reveal.js" :: String) $
defField "s5-url" ("s5/default" :: String) $
("https://www.w3.org/Talks/Tools/Slidy2" :: Text) $
defField "slideous-url" ("slideous" :: Text) $
defField "revealjs-url" ("reveal.js" :: Text) $
defField "s5-url" ("s5/default" :: Text) $
defField "html5" (stHtml5 st)
metadata
return (thebody, context)

66
src/Text/Pandoc/Writers/Haddock.hs
View file

@ -23,7 +23,7 @@ import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@ -49,23 +49,20 @@ pandocToHaddock opts (Pandoc meta blocks) = do
body <- blockListToHaddock opts blocks
st <- get
notes' <- notesToHaddock opts (reverse $ stNotes st)
let render' :: Doc -> Text
render' = render colwidth
let main = render' $ body <>
(if isEmpty notes' then empty else blankline <> notes')
metadata <- metaToJSON opts
(fmap render' . blockListToHaddock opts)
(fmap render' . inlineListToHaddock opts)
let main = body <> (if isEmpty notes' then empty else blankline <> notes')
metadata <- metaToContext opts
(blockListToHaddock opts)
(fmap chomp . inlineListToHaddock opts)
meta
let context = defField "body" main metadata
return $
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Return haddock representation of notes.
notesToHaddock :: PandocMonad m
=> WriterOptions -> [[Block]] -> StateT WriterState m Doc
=> WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text)
notesToHaddock opts notes =
if null notes
then return empty
@ -82,7 +79,7 @@ escapeString = escapeStringUsing haddockEscapes
blockToHaddock :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
-> StateT WriterState m Doc
-> StateT WriterState m (Doc Text)
blockToHaddock _ Null = return empty
blockToHaddock opts (Div _ ils) = do
contents <- blockListToHaddock opts ils
@ -129,7 +126,7 @@ blockToHaddock opts (Table caption aligns widths headers rows) = do
return $ prefixed "> " (tbl $$ blankline $$ caption'') $$ blankline
blockToHaddock opts (BulletList items) = do
contents <- mapM (bulletListItemToHaddock opts) items
return $ cat contents <> blankline
return $ (if isTightList items then vcat else vsep) contents <> blankline
blockToHaddock opts (OrderedList (start,_,delim) items) = do
let attribs = (start, Decimal, delim)
let markers = orderedListMarkers attribs
@ -137,69 +134,72 @@ blockToHaddock opts (OrderedList (start,_,delim) items) = do
then m ++ replicate (3 - length m) ' '
else m) markers
contents <- zipWithM (orderedListItemToHaddock opts) markers' items
return $ cat contents <> blankline
return $ (if isTightList items then vcat else vsep) contents <> blankline
blockToHaddock opts (DefinitionList items) = do
contents <- mapM (definitionListItemToHaddock opts) items
return $ cat contents <> blankline
return $ vcat contents <> blankline
-- | Convert bullet list item (list of blocks) to haddock
bulletListItemToHaddock :: PandocMonad m
=> WriterOptions -> [Block] -> StateT WriterState m Doc
=> WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToHaddock opts items = do
contents <- blockListToHaddock opts items
let sps = replicate (writerTabStop opts - 2) ' '
let start = text ('-' : ' ' : sps)
-- remove trailing blank line if it is a tight list
let contents' = case reverse items of
(BulletList xs:_) | isTightList xs ->
chomp contents <> cr
(OrderedList _ xs:_) | isTightList xs ->
chomp contents <> cr
_ -> contents
return $ hang (writerTabStop opts) start $ contents' <> cr
return $ hang (writerTabStop opts) start contents $$
if endsWithPlain items
then cr
else blankline
-- | Convert ordered list item (a list of blocks) to haddock
orderedListItemToHaddock :: PandocMonad m
=> WriterOptions -- ^ options
-> String -- ^ list item marker
-> [Block] -- ^ list item (list of blocks)
-> StateT WriterState m Doc
-> StateT WriterState m (Doc Text)
orderedListItemToHaddock opts marker items = do
contents <- blockListToHaddock opts items
let sps = case length marker - writerTabStop opts of
n | n > 0 -> text $ replicate n ' '
_ -> text " "
let start = text marker <> sps
return $ hang (writerTabStop opts) start $ contents <> cr
return $ hang (writerTabStop opts) start contents $$
if endsWithPlain items
then cr
else blankline
-- | Convert definition list item (label, list of blocks) to haddock
definitionListItemToHaddock :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> StateT WriterState m Doc
-> StateT WriterState m (Doc Text)
definitionListItemToHaddock opts (label, defs) = do
labelText <- inlineListToHaddock opts label
defs' <- mapM (mapM (blockToHaddock opts)) defs
let contents = vcat $ map (\d -> hang 4 empty $ vcat d <> cr) defs'
return $ nowrap (brackets labelText) <> cr <> contents <> cr
let contents = (if isTightList defs then vcat else vsep) $
map (\d -> hang 4 empty $ vcat d <> cr) defs'
return $ nowrap (brackets labelText) $$ contents $$
if isTightList defs
then cr
else blankline
-- | Convert list of Pandoc block elements to haddock
blockListToHaddock :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
-> StateT WriterState m Doc
-> StateT WriterState m (Doc Text)
blockListToHaddock opts blocks =
cat <$> mapM (blockToHaddock opts) blocks
mconcat <$> mapM (blockToHaddock opts) blocks
-- | Convert list of Pandoc inline elements to haddock.
inlineListToHaddock :: PandocMonad m
=> WriterOptions -> [Inline] -> StateT WriterState m Doc
=> WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock opts lst =
cat <$> mapM (inlineToHaddock opts) lst
mconcat <$> mapM (inlineToHaddock opts) lst
-- | Convert Pandoc inline element to haddock.
inlineToHaddock :: PandocMonad m
=> WriterOptions -> Inline -> StateT WriterState m Doc
=> WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToHaddock opts (Span (ident,_,_) ils) = do
contents <- inlineListToHaddock opts ils
if not (null ident) && null ils

57
src/Text/Pandoc/Writers/ICML.hs
View file

@ -31,7 +31,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared (isURI, linesToPara, splitBy)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math (texMathToInlines)
@ -136,21 +136,18 @@ writeICML opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
render' :: Doc -> Text
render' = render colwidth
renderMeta f s = liftM (render' . fst) $ runStateT (f opts [] s) defaultWriterState
metadata <- metaToJSON opts
renderMeta f s = fst <$> runStateT (f opts [] s) defaultWriterState
metadata <- metaToContext opts
(renderMeta blocksToICML)
(renderMeta inlinesToICML)
meta
(doc, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState
let main = render' doc
context = defField "body" main
$ defField "charStyles" (render' $ charStylesToDoc st)
$ defField "parStyles" (render' $ parStylesToDoc st)
$ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) metadata
return $
(if writerPreferAscii opts then toEntities else id) $
(main, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState
let context = defField "body" main
$ defField "charStyles" (charStylesToDoc st)
$ defField "parStyles" (parStylesToDoc st)
$ defField "hyperlinks" (hyperlinksToDoc $ links st) metadata
return $ render colwidth $
(if writerPreferAscii opts then fmap toEntities else id) $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@ -161,7 +158,7 @@ contains s rule =
[snd rule | (fst rule) `isInfixOf` s]
-- | The monospaced font to use as default.
monospacedFont :: Doc
monospacedFont :: Doc Text
monospacedFont = inTags False "AppliedFont" [("type", "string")] $ text "Courier New"
-- | How much to indent blockquotes etc.
@ -177,7 +174,7 @@ lineSeparator :: String
lineSeparator = "&#x2028;"
-- | Convert a WriterState with its block styles to the ICML listing of Paragraph Styles.
parStylesToDoc :: WriterState -> Doc
parStylesToDoc :: WriterState -> Doc Text
parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st
where
makeStyle s =
@ -243,7 +240,7 @@ parStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ blockStyles st
in inTags True "ParagraphStyle" ([("Self", "ParagraphStyle/"++s), ("Name", s)] ++ attrs') props
-- | Convert a WriterState with its inline styles to the ICML listing of Character Styles.
charStylesToDoc :: WriterState -> Doc
charStylesToDoc :: WriterState -> Doc Text
charStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ inlineStyles st
where
makeStyle s =
@ -274,7 +271,7 @@ escapeColons (x:xs)
escapeColons [] = []
-- | Convert a list of (identifier, url) pairs to the ICML listing of hyperlinks.
hyperlinksToDoc :: Hyperlink -> Doc
hyperlinksToDoc :: Hyperlink -> Doc Text
hyperlinksToDoc [] = empty
hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs
where
@ -293,13 +290,13 @@ dynamicStyleKey :: String
dynamicStyleKey = "custom-style"
-- | Convert a list of Pandoc blocks to ICML.
blocksToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc
blocksToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML opts style lst = do
docs <- mapM (blockToICML opts style) lst
return $ intersperseBrs docs
-- | Convert a Pandoc block element to ICML.
blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m Doc
blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML opts style (Plain lst) = parStyle opts style lst
-- title beginning with fig: indicates that the image is a figure
blockToICML opts style (Para img@[Image _ txt (_,'f':'i':'g':':':_)]) = do
@ -375,7 +372,7 @@ blockToICML opts style (Div (_, _, kvs) lst) =
blockToICML _ _ Null = return empty
-- | Convert a list of lists of blocks to ICML list items.
listItemsToICML :: PandocMonad m => WriterOptions -> String -> Style -> Maybe ListAttributes -> [[Block]] -> WS m Doc
listItemsToICML :: PandocMonad m => WriterOptions -> String -> Style -> Maybe ListAttributes -> [[Block]] -> WS m (Doc Text)
listItemsToICML _ _ _ _ [] = return empty
listItemsToICML opts listType style attribs (first:rest) = do
st <- get
@ -390,7 +387,7 @@ listItemsToICML opts listType style attribs (first:rest) = do
return $ intersperseBrs docs
-- | Convert a list of blocks to ICML list items.
listItemToICML :: PandocMonad m => WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS m Doc
listItemToICML :: PandocMonad m => WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS m (Doc Text)
listItemToICML opts style isFirst attribs item =
let makeNumbStart (Just (beginsWith, numbStl, _)) =
let doN DefaultStyle = []
@ -416,7 +413,7 @@ listItemToICML opts style isFirst attribs item =
return $ intersperseBrs (f : r)
else blocksToICML opts stl' item
definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m Doc
definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m (Doc Text)
definitionListItemToICML opts style (term,defs) = do
term' <- parStyle opts (defListTermName:style) term
defs' <- mapM (blocksToICML opts (defListDefName:style)) defs
@ -424,11 +421,11 @@ definitionListItemToICML opts style (term,defs) = do
-- | Convert a list of inline elements to ICML.
inlinesToICML :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m Doc
inlinesToICML :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m (Doc Text)
inlinesToICML opts style lst = vcat `fmap` mapM (inlineToICML opts style) (mergeStrings opts lst)
-- | Convert an inline element to ICML.
inlineToICML :: PandocMonad m => WriterOptions -> Style -> Inline -> WS m Doc
inlineToICML :: PandocMonad m => WriterOptions -> Style -> Inline -> WS m (Doc Text)
inlineToICML _ style (Str str) = charStyle style $ text $ escapeStringForXML str
inlineToICML opts style (Emph lst) = inlinesToICML opts (emphName:style) lst
inlineToICML opts style (Strong lst) = inlinesToICML opts (strongName:style) lst
@ -451,7 +448,7 @@ inlineToICML opts style SoftBreak =
inlineToICML _ style LineBreak = charStyle style $ text lineSeparator
inlineToICML opts style (Math mt str) =
lift (texMathToInlines mt str) >>=
(fmap cat . mapM (inlineToICML opts style))
(fmap mconcat . mapM (inlineToICML opts style))
inlineToICML _ _ il@(RawInline f str)
| f == Format "icml" = return $ text str
| otherwise = do
@ -474,7 +471,7 @@ inlineToICML opts style (Span (_, _, kvs) lst) =
in inlinesToICML opts (dynamicStyle <> style) lst
-- | Convert a list of block elements to an ICML footnote.
footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc
footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m (Doc Text)
footnoteToICML opts style lst =
let insertTab (Para ls) = blockToICML opts (footnoteName:style) $ Para $ Str "\t":ls
insertTab block = blockToICML opts (footnoteName:style) block
@ -500,11 +497,11 @@ mergeStrings opts = mergeStrings' . map spaceToStr
mergeStrings' [] = []
-- | Intersperse line breaks
intersperseBrs :: [Doc] -> Doc
intersperseBrs :: [Doc Text] -> Doc Text
intersperseBrs = vcat . intersperse (selfClosingTag "Br" []) . filter (not . isEmpty)
-- | Wrap a list of inline elements in an ICML Paragraph Style
parStyle :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m Doc
parStyle :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m (Doc Text)
parStyle opts style lst =
let slipIn x y = if null y
then x
@ -528,7 +525,7 @@ parStyle opts style lst =
state $ \st -> (cont, st{ blockStyles = Set.insert stlStr $ blockStyles st })
-- | Wrap a Doc in an ICML Character Style.
charStyle :: PandocMonad m => Style -> Doc -> WS m Doc
charStyle :: PandocMonad m => Style -> Doc Text -> WS m (Doc Text)
charStyle style content =
let (stlStr, attrs) = styleToStrAttr style
doc = inTags True "CharacterStyleRange" attrs $ inTagsSimple "Content" $ flush content
@ -550,7 +547,7 @@ styleToStrAttr style =
in (stlStr, attrs)
-- | Assemble an ICML Image.
imageICML :: PandocMonad m => WriterOptions -> Style -> Attr -> Target -> WS m Doc
imageICML :: PandocMonad m => WriterOptions -> Style -> Attr -> Target -> WS m (Doc Text)
imageICML opts style attr (src, _) = do
imgS <- catchError
(do (img, _) <- P.fetchItem src

11
src/Text/Pandoc/Writers/Ipynb.hs
View file

@ -33,7 +33,7 @@ import qualified Data.Text as T
import Data.Aeson as Aeson
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Shared (safeRead, isURI)
import Text.Pandoc.Writers.Shared (metaToJSON')
import Text.Pandoc.Writers.Shared (metaToContext')
import Text.Pandoc.Writers.Markdown (writeMarkdown)
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BL
@ -73,9 +73,10 @@ pandocToNotebook opts (Pandoc meta blocks) = do
Just z -> (4, z)
Nothing -> (4, 5)
_ -> (4, 5) -- write as v4.5
metadata' <- metaToJSON' blockWriter inlineWriter $
B.deleteMeta "nbformat" $
B.deleteMeta "nbformat_minor" $ jupyterMeta
metadata' <- toJSON <$> metaToContext' blockWriter inlineWriter
(B.deleteMeta "nbformat" $
B.deleteMeta "nbformat_minor" $
jupyterMeta)
-- convert from a Value (JSON object) to a M.Map Text Value:
let metadata = case fromJSON metadata' of
Error _ -> mempty -- TODO warning here? shouldn't happen
@ -109,7 +110,7 @@ extractCells opts (Div (_id,classes,kvs) xs : bs)
source <- writeMarkdown opts{ writerTemplate = Nothing } newdoc
(Cell{
cellType = Markdown
, cellSource = Source $ breakLines source
, cellSource = Source $ breakLines $ T.stripEnd source
, cellMetadata = meta
, cellAttachments = if M.null attachments
then Nothing

71
src/Text/Pandoc/Writers/JATS.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Writers.JATS
@ -23,6 +24,7 @@ import Data.List (partition, isPrefixOf)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
import qualified Data.Text as T
import Data.Text (Text)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@ -31,9 +33,10 @@ import Text.Pandoc.Logging
import Text.Pandoc.MIME (getMimeType)
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.DocTemplates (Context(..), Val(..), TemplateTarget(..))
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
@ -44,7 +47,7 @@ data JATSVersion = JATS1_1
deriving (Eq, Show)
data JATSState = JATSState
{ jatsNotes :: [(Int, Doc)] }
{ jatsNotes :: [(Int, Doc Text)] }
type JATS a = StateT JATSState (ReaderT JATSVersion a)
@ -65,54 +68,56 @@ docToJATS opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
-- The numbering here follows LaTeX's internal numbering
let startLvl = case writerTopLevelDivision opts of
TopLevelPart -> -1
TopLevelChapter -> 0
TopLevelSection -> 1
TopLevelDefault -> 1
metadata <- metaToJSON opts
(fmap (render' . vcat) .
metadata <- metaToContext opts
(fmap vcat .
mapM (elementToJATS opts startLvl) .
hierarchicalize)
(fmap render' . inlinesToJATS opts)
(fmap chomp . inlinesToJATS opts)
meta
main <- (render' . vcat) <$>
mapM (elementToJATS opts startLvl) elements
main <- vcat <$> mapM (elementToJATS opts startLvl) elements
notes <- reverse . map snd <$> gets jatsNotes
backs <- mapM (elementToJATS opts startLvl) backElements
let fns = if null notes
then mempty
else inTagsIndented "fn-group" $ vcat notes
let back = render' $ vcat backs $$ fns
let date = case getField "date" metadata -- an object
`mplus`
(getField "date" metadata >>= parseDate) of
Nothing -> mempty
let back = vcat backs $$ fns
let date =
case getField "date" metadata of
Nothing -> NullVal
Just (SimpleVal (x :: Doc Text)) ->
case parseDate (T.unpack $ toText x) of
Nothing -> NullVal
Just day ->
let (y,m,d) = toGregorian day
in M.insert ("year" :: String) (show y)
$ M.insert "month" (show m)
$ M.insert "day" (show d)
in MapVal $ Context
$ M.insert ("year" :: Text) (SimpleVal $ text $ show y)
$ M.insert "month" (SimpleVal $ text $ show m)
$ M.insert "day" (SimpleVal $ text $ show d)
$ M.insert "iso-8601"
(formatTime defaultTimeLocale "%F" day)
(SimpleVal $ text $
formatTime defaultTimeLocale "%F" day)
$ mempty
Just x -> x
let context = defField "body" main
$ defField "back" back
$ resetField ("date" :: String) date
$ resetField "date" date
$ defField "mathml" (case writerHTMLMathMethod opts of
MathML -> True
_ -> False) metadata
return $
(if writerPreferAscii opts then toEntities else id) $
return $ render colwidth $
(if writerPreferAscii opts then fmap toEntities else id) $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Convert an Element to JATS.
elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> JATS m Doc
elementToJATS :: PandocMonad m => WriterOptions -> Int -> Element -> JATS m (Doc Text)
elementToJATS opts _ (Blk block) = blockToJATS opts block
elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do
let idAttr = [("id", writerIdentifierPrefix opts ++ id') | not (null id')]
@ -124,14 +129,14 @@ elementToJATS opts lvl (Sec _ _num (id',_,kvs) title elements) = do
inTagsSimple "title" title' $$ vcat contents
-- | Convert a list of Pandoc blocks to JATS.
blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m Doc
blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS = wrappedBlocksToJATS (const False)
wrappedBlocksToJATS :: PandocMonad m
=> (Block -> Bool)
-> WriterOptions
-> [Block]
-> JATS m Doc
-> JATS m (Doc Text)
wrappedBlocksToJATS needsWrap opts =
fmap vcat . mapM wrappedBlockToJATS
where
@ -150,13 +155,13 @@ plainToPara x = x
-- | Convert a list of pairs of terms and definitions into a list of
-- JATS varlistentrys.
deflistItemsToJATS :: PandocMonad m
=> WriterOptions -> [([Inline],[[Block]])] -> JATS m Doc
=> WriterOptions -> [([Inline],[[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS opts items =
vcat <$> mapM (uncurry (deflistItemToJATS opts)) items
-- | Convert a term and a list of blocks into a JATS varlistentry.
deflistItemToJATS :: PandocMonad m
=> WriterOptions -> [Inline] -> [[Block]] -> JATS m Doc
=> WriterOptions -> [Inline] -> [[Block]] -> JATS m (Doc Text)
deflistItemToJATS opts term defs = do
term' <- inlinesToJATS opts term
def' <- wrappedBlocksToJATS (not . isPara)
@ -168,7 +173,7 @@ deflistItemToJATS opts term defs = do
-- | Convert a list of lists of blocks to a list of JATS list items.
listItemsToJATS :: PandocMonad m
=> WriterOptions -> Maybe [String] -> [[Block]] -> JATS m Doc
=> WriterOptions -> Maybe [String] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS opts markers items =
case markers of
Nothing -> vcat <$> mapM (listItemToJATS opts Nothing) items
@ -176,7 +181,7 @@ listItemsToJATS opts markers items =
-- | Convert a list of blocks into a JATS list item.
listItemToJATS :: PandocMonad m
=> WriterOptions -> Maybe String -> [Block] -> JATS m Doc
=> WriterOptions -> Maybe String -> [Block] -> JATS m (Doc Text)
listItemToJATS opts mbmarker item = do
contents <- wrappedBlocksToJATS (not . isParaOrList) opts
(walk demoteHeaderAndRefs item)
@ -218,7 +223,7 @@ codeAttr (ident,classes,kvs) = (lang, attr)
lang = languageFor classes
-- | Convert a Pandoc block element to JATS.
blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m Doc
blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS _ Null = return empty
-- Bibliography reference:
blockToJATS opts (Div ('r':'e':'f':'-':_,_,_) [Para lst]) =
@ -341,7 +346,7 @@ tableRowToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [[Block]]
-> JATS m Doc
-> JATS m (Doc Text)
tableRowToJATS opts isHeader cols =
(inTagsIndented "tr" . vcat) <$> mapM (tableItemToJATS opts isHeader) cols
@ -349,7 +354,7 @@ tableItemToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [Block]
-> JATS m Doc
-> JATS m (Doc Text)
tableItemToJATS opts isHeader [Plain item] =
inTags False (if isHeader then "th" else "td") [] <$>
inlinesToJATS opts item
@ -358,7 +363,7 @@ tableItemToJATS opts isHeader item =
mapM (blockToJATS opts) item
-- | Convert a list of inline elements to JATS.
inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m Doc
inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) (fixCitations lst)
where
fixCitations [] = []
@ -374,7 +379,7 @@ inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) (fixCitations lst)
fixCitations (x:xs) = x : fixCitations xs
-- | Convert an inline element to JATS.
inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> JATS m Doc
inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> JATS m (Doc Text)
inlineToJATS _ (Str str) = return $ text $ escapeStringForXML str
inlineToJATS opts (Emph lst) =
inTagsSimple "italic" <$> inlinesToJATS opts lst

4
src/Text/Pandoc/Writers/Jira.hs
View file

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

121
src/Text/Pandoc/Writers/LaTeX.hs
View file

@ -21,7 +21,6 @@ import Prelude
import Control.Applicative ((<|>))
import Control.Monad.State.Strict
import Data.Monoid (Any(..))
import Data.Aeson (object, (.=))
import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isSpace,
isPunctuation, ord, toLower)
import Data.List (foldl', intercalate, intersperse, nubBy,
@ -39,10 +38,11 @@ import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight,
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Slides
import Text.Pandoc.Templates
import Text.Pandoc.Templates (renderTemplate)
import Text.DocTemplates (Val(..), Context(..))
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
@ -56,7 +56,7 @@ data WriterState =
, stInMinipage :: Bool -- true if in minipage
, stInHeading :: Bool -- true if in a section heading
, stInItem :: Bool -- true if in \item[..]
, stNotes :: [Doc] -- notes in a minipage
, stNotes :: [Doc Text] -- notes in a minipage
, stOLLevel :: Int -- level of ordered list nesting
, stOptions :: WriterOptions -- writer options, so they don't have to be parameter
, stVerbInNote :: Bool -- true if document has verbatim text in note
@ -133,11 +133,9 @@ pandocToLaTeX options (Pandoc meta blocks) = do
let colwidth = if writerWrapText options == WrapAuto
then Just $ writerColumns options
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON options
(fmap render' . blockListToLaTeX)
(fmap render' . inlineListToLaTeX)
metadata <- metaToContext options
blockListToLaTeX
(fmap chomp . inlineListToLaTeX)
meta
let chaptersClasses = ["memoir","book","report","scrreprt","scrbook","extreport","extbook","tufte-book"]
let frontmatterClasses = ["memoir","book","scrbook","extbook","tufte-book"]
@ -154,7 +152,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do
_ -> "article"
when (documentClass `elem` chaptersClasses) $
modify $ \s -> s{ stHasChapters = True }
case T.toLower <$> getField "csquotes" metadata of
case T.toLower . render Nothing <$> getField "csquotes" metadata of
Nothing -> return ()
Just "false" -> return ()
Just _ -> modify $ \s -> s{stCsquotes = True}
@ -167,23 +165,26 @@ pandocToLaTeX options (Pandoc meta blocks) = do
then toSlides blocks''
else return blocks''
body <- mapM (elementToLaTeX options) $ hierarchicalize blocks'''
(biblioTitle :: Text) <- render' <$> inlineListToLaTeX lastHeader
let main = render' $ vsep body
biblioTitle <- inlineListToLaTeX lastHeader
let main = vsep body
st <- get
titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta
authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta
docLangs <- catMaybes <$>
mapM (toLang . Just) (ordNub (query (extract "lang") blocks))
let hasStringValue x = isJust (getField x metadata :: Maybe String)
let geometryFromMargins = intercalate [','] $ mapMaybe (\(x,y) ->
((x ++ "=") ++) <$> getField y metadata)
let hasStringValue x = isJust (getField x metadata :: Maybe (Doc Text))
let geometryFromMargins = mconcat $ intersperse ("," :: Doc Text) $
mapMaybe (\(x,y) ->
((x <> "=") <>) <$> getField y metadata)
[("lmargin","margin-left")
,("rmargin","margin-right")
,("tmargin","margin-top")
,("bmargin","margin-bottom")
]
let toPolyObj lang = object [ "name" .= T.pack name
, "options" .= T.pack opts ]
let toPolyObj :: Lang -> Val (Doc Text)
toPolyObj lang = MapVal $ Context $
M.fromList [ ("name" , SimpleVal $ text name)
, ("options" , SimpleVal $ text opts) ]
where
(name, opts) = toPolyglossia lang
mblang <- toLang $ case getLang options meta of
@ -195,14 +196,16 @@ pandocToLaTeX options (Pandoc meta blocks) = do
let dirs = query (extract "dir") blocks
let context = defField "toc" (writerTableOfContents options) $
defField "toc-depth" (show (writerTOCDepth options -
defField "toc-depth" (T.pack . show $
(writerTOCDepth options -
if stHasChapters st
then 1
else 0)) $
defField "body" main $
defField "title-meta" titleMeta $
defField "author-meta" (intercalate "; " authorsMeta) $
defField "documentclass" documentClass $
defField "title-meta" (T.pack titleMeta) $
defField "author-meta"
(T.pack $ intercalate "; " authorsMeta) $
defField "documentclass" (T.pack documentClass) $
defField "verbatim-in-note" (stVerbInNote st) $
defField "tables" (stTable st) $
defField "strikeout" (stStrikeout st) $
@ -218,7 +221,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do
then case writerHighlightStyle options of
Just sty ->
defField "highlighting-macros"
(styleToLaTeX sty)
(T.stripEnd $ styleToLaTeX sty)
Nothing -> id
else id) $
(case writerCiteMethod options of
@ -232,23 +235,28 @@ pandocToLaTeX options (Pandoc meta blocks) = do
"filecolor"]) $
(if null dirs
then id
else defField "dir" ("ltr" :: String)) $
else defField "dir" ("ltr" :: Text)) $
defField "section-titles" True $
defField "geometry" geometryFromMargins $
(case getField "papersize" metadata of
(case T.unpack . render Nothing <$>
getField "papersize" metadata of
-- uppercase a4, a5, etc.
Just (('A':d:ds) :: String)
| all isDigit (d:ds) -> resetField "papersize"
(('a':d:ds) :: String)
(T.pack ('a':d:ds))
_ -> id)
metadata
let context' =
-- note: lang is used in some conditionals in the template,
-- so we need to set it if we have any babel/polyglossia:
maybe id (defField "lang" . renderLang) mblang
$ maybe id (defField "babel-lang" . toBabel) mblang
$ defField "babel-otherlangs" (map toBabel docLangs)
$ defField "babel-newcommands" (concatMap (\(poly, babel) ->
maybe id (\l -> defField "lang"
((text $ renderLang l) :: Doc Text)) mblang
$ maybe id (\l -> defField "babel-lang"
((text $ toBabel l) :: Doc Text)) mblang
$ defField "babel-otherlangs"
(map ((text . toBabel) :: Lang -> Doc Text) docLangs)
$ defField "babel-newcommands" (vcat $
map (\(poly, babel) -> (text :: String -> Doc Text) $
-- \textspanish and \textgalician are already used by babel
-- save them as \oritext... and let babel use that
if poly `elem` ["spanish", "galician"]
@ -258,14 +266,14 @@ pandocToLaTeX options (Pandoc meta blocks) = do
++ poly ++ "}}\n" ++
"\\AddBabelHook{" ++ poly ++ "}{afterextras}" ++
"{\\renewcommand{\\text" ++ poly ++ "}[2][]{\\foreignlanguage{"
++ poly ++ "}{##2}}}\n"
++ poly ++ "}{##2}}}"
else (if poly == "latin" -- see #4161
then "\\providecommand{\\textlatin}{}\n\\renewcommand"
else "\\newcommand") ++ "{\\text" ++ poly ++
"}[2][]{\\foreignlanguage{" ++ babel ++ "}{#2}}\n" ++
"\\newenvironment{" ++ poly ++
"}[2][]{\\begin{otherlanguage}{" ++
babel ++ "}}{\\end{otherlanguage}}\n"
babel ++ "}}{\\end{otherlanguage}}"
)
-- eliminate duplicates that have same polyglossia name
$ nubBy (\a b -> fst a == fst b)
@ -273,17 +281,19 @@ pandocToLaTeX options (Pandoc meta blocks) = do
$ map (\l -> (fst $ toPolyglossia l, toBabel l)) docLangs
)
$ maybe id (defField "polyglossia-lang" . toPolyObj) mblang
$ defField "polyglossia-otherlangs" (map toPolyObj docLangs)
$ defField "polyglossia-otherlangs"
(ListVal (map toPolyObj docLangs :: [Val (Doc Text)]))
$
defField "latex-dir-rtl"
(getField "dir" context == Just ("rtl" :: String)) context
return $
((render Nothing <$> getField "dir" context) ==
Just ("rtl" :: Text)) context
return $ render colwidth $
case writerTemplate options of
Nothing -> main
Just tpl -> renderTemplate tpl context'
-- | Convert Elements to LaTeX
elementToLaTeX :: PandocMonad m => WriterOptions -> Element -> LW m Doc
elementToLaTeX :: PandocMonad m => WriterOptions -> Element -> LW m (Doc Text)
elementToLaTeX _ (Blk block) = blockToLaTeX block
elementToLaTeX opts (Sec level _ (id',classes,_) title' elements) = do
modify $ \s -> s{stInHeading = True}
@ -435,7 +445,7 @@ toLabel z = go `fmap` stringToLaTeX URLString z
| otherwise = "ux" ++ printf "%x" (ord x) ++ go xs
-- | Puts contents into LaTeX command.
inCmd :: String -> Doc -> Doc
inCmd :: String -> Doc Text -> Doc Text
inCmd cmd contents = char '\\' <> text cmd <> braces contents
toSlides :: PandocMonad m => [Block] -> LW m [Block]
@ -514,7 +524,7 @@ isListBlock _ = False
-- | Convert Pandoc block element to LaTeX.
blockToLaTeX :: PandocMonad m
=> Block -- ^ Block to convert
-> LW m Doc
-> LW m (Doc Text)
blockToLaTeX Null = return empty
blockToLaTeX (Div (identifier,classes,kvs) bs)
| "incremental" `elem` classes = do
@ -820,7 +830,8 @@ blockToLaTeX (Table caption aligns widths heads rows) = do
$$ captNotes
$$ notes
getCaption :: PandocMonad m => Bool -> [Inline] -> LW m (Doc, Doc, Doc)
getCaption :: PandocMonad m
=> Bool -> [Inline] -> LW m (Doc Text, Doc Text, Doc Text)
getCaption externalNotes txt = do
oldExternalNotes <- gets stExternalNotes
modify $ \st -> st{ stExternalNotes = externalNotes, stNotes = [] }
@ -846,7 +857,7 @@ toColDescriptor align =
AlignCenter -> "c"
AlignDefault -> "l"
blockListToLaTeX :: PandocMonad m => [Block] -> LW m Doc
blockListToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX lst =
vsep `fmap` mapM (\b -> setEmptyLine True >> blockToLaTeX b) lst
@ -855,7 +866,7 @@ tableRowToLaTeX :: PandocMonad m
-> [Alignment]
-> [Double]
-> [[Block]]
-> LW m Doc
-> LW m (Doc Text)
tableRowToLaTeX header aligns widths cols = do
-- scale factor compensates for extra space between columns
-- so the whole table isn't larger than columnwidth
@ -897,7 +908,7 @@ displayMathToInline (Math DisplayMath x) = Math InlineMath x
displayMathToInline x = x
tableCellToLaTeX :: PandocMonad m => Bool -> (Double, Alignment, [Block])
-> LW m Doc
-> LW m (Doc Text)
tableCellToLaTeX _ (0, _, blocks) =
blockListToLaTeX $ walk fixLineBreaks $ walk displayMathToInline blocks
tableCellToLaTeX header (width, align, blocks) = do
@ -922,7 +933,7 @@ tableCellToLaTeX header (width, align, blocks) = do
(halign <> cr <> cellContents <> "\\strut" <> cr) <>
"\\end{minipage}")
notesToLaTeX :: [Doc] -> Doc
notesToLaTeX :: [Doc Text] -> Doc Text
notesToLaTeX [] = empty
notesToLaTeX ns = (case length ns of
n | n > 1 -> "\\addtocounter" <>
@ -935,7 +946,7 @@ notesToLaTeX ns = (case length ns of
$ map (\x -> "\\footnotetext" <> braces x)
$ reverse ns)
listItemToLaTeX :: PandocMonad m => [Block] -> LW m Doc
listItemToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text)
listItemToLaTeX lst
-- we need to put some text before a header if it's the first
-- element in an item. This will look ugly in LaTeX regardless, but
@ -957,7 +968,7 @@ listItemToLaTeX lst
return $ "\\item" <> brackets checkbox
$$ nest 2 (isContents $+$ bsContents)
defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m Doc
defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m (Doc Text)
defListItemToLaTeX (term, defs) = do
-- needed to turn off 'listings' because it breaks inside \item[...]:
modify $ \s -> s{stInItem = True}
@ -985,7 +996,7 @@ sectionHeader :: PandocMonad m
-> [Char]
-> Int
-> [Inline]
-> LW m Doc
-> LW m (Doc Text)
sectionHeader unnumbered ident level lst = do
txt <- inlineListToLaTeX lst
plain <- stringToLaTeX TextString $ concatMap stringify lst
@ -1002,7 +1013,7 @@ sectionHeader unnumbered ident level lst = do
then return empty
else
return $ brackets txtNoNotes
let contents = if render Nothing txt == plain
let contents = if render Nothing txt == T.pack plain
then braces txt
else braces (text "\\texorpdfstring"
<> braces txt
@ -1051,7 +1062,7 @@ sectionHeader unnumbered ident level lst = do
braces txtNoNotes
else empty
hypertarget :: PandocMonad m => Bool -> String -> Doc -> LW m Doc
hypertarget :: PandocMonad m => Bool -> String -> Doc Text -> LW m (Doc Text)
hypertarget _ "" x = return x
hypertarget addnewline ident x = do
ref <- text `fmap` toLabel ident
@ -1061,7 +1072,7 @@ hypertarget addnewline ident x = do
then ("%" <> cr)
else empty) <> x)
labelFor :: PandocMonad m => String -> LW m Doc
labelFor :: PandocMonad m => String -> LW m (Doc Text)
labelFor "" = return empty
labelFor ident = do
ref <- text `fmap` toLabel ident
@ -1070,7 +1081,7 @@ labelFor ident = do
-- | Convert list of inline elements to LaTeX.
inlineListToLaTeX :: PandocMonad m
=> [Inline] -- ^ Inlines to convert
-> LW m Doc
-> LW m (Doc Text)
inlineListToLaTeX lst =
mapM inlineToLaTeX (fixLineInitialSpaces . fixInitialLineBreaks $ lst)
>>= return . hcat
@ -1098,7 +1109,7 @@ isQuoted _ = False
-- | Convert inline element to LaTeX
inlineToLaTeX :: PandocMonad m
=> Inline -- ^ Inline to convert
-> LW m Doc
-> LW m (Doc Text)
inlineToLaTeX (Span (id',classes,kvs) ils) = do
linkAnchor <- hypertarget False id' empty
lang <- toLang $ lookup "lang" kvs
@ -1293,7 +1304,7 @@ inlineToLaTeX (Image attr _ (source, _)) = do
dimList = showDim Width ++ showDim Height
dims = if null dimList
then empty
else brackets $ cat (intersperse "," dimList)
else brackets $ mconcat (intersperse "," dimList)
source' = if isURI source
then source
else unEscapeString source
@ -1342,7 +1353,7 @@ protectCode x = [x]
setEmptyLine :: PandocMonad m => Bool -> LW m ()
setEmptyLine b = modify $ \st -> st{ stEmptyLine = b }
citationsToNatbib :: PandocMonad m => [Citation] -> LW m Doc
citationsToNatbib :: PandocMonad m => [Citation] -> LW m (Doc Text)
citationsToNatbib
[one]
= citeCommand c p s k
@ -1393,13 +1404,13 @@ citationsToNatbib cits = do
NormalCitation -> citeCommand "citealp" p s k
citeCommand :: PandocMonad m
=> String -> [Inline] -> [Inline] -> String -> LW m Doc
=> String -> [Inline] -> [Inline] -> String -> LW m (Doc Text)
citeCommand c p s k = do
args <- citeArguments p s k
return $ text ("\\" ++ c) <> args
citeArguments :: PandocMonad m
=> [Inline] -> [Inline] -> String -> LW m Doc
=> [Inline] -> [Inline] -> String -> LW m (Doc Text)
citeArguments p s k = do
let s' = case s of
(Str
@ -1414,7 +1425,7 @@ citeArguments p s k = do
(_ , _ ) -> brackets pdoc <> brackets sdoc
return $ optargs <> braces (text k)
citationsToBiblatex :: PandocMonad m => [Citation] -> LW m Doc
citationsToBiblatex :: PandocMonad m => [Citation] -> LW m (Doc Text)
citationsToBiblatex
[one]
= citeCommand cmd p s k

38
src/Text/Pandoc/Writers/Man.hs
View file

@ -24,10 +24,10 @@ import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Templates
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Writers.Roff
@ -44,10 +44,8 @@ pandocToMan opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
titleText <- inlineListToMan opts $ docTitle meta
let title' = render' titleText
let title' = render Nothing titleText
let setFieldsFromTitle =
case T.break (== ' ') title' of
(cmdName, rest) -> case T.break (=='(') cmdName of
@ -62,21 +60,21 @@ pandocToMan opts (Pandoc meta blocks) = do
(T.strip $ mconcat hds)
[] -> id
_ -> defField "title" title'
metadata <- metaToJSON opts
(fmap render' . blockListToMan opts)
(fmap render' . inlineListToMan opts)
metadata <- metaToContext opts
(blockListToMan opts)
(fmap chomp . inlineListToMan opts)
$ deleteMeta "title" meta
body <- blockListToMan opts blocks
notes <- gets stNotes
notes' <- notesToMan opts (reverse notes)
let main = render' $ body $$ notes' $$ text ""
let main = body $$ notes' $$ text ""
hasTables <- gets stHasTables
let context = defField "body" main
$ setFieldsFromTitle
$ defField "has-tables" hasTables
$ defField "hyphenate" True
$ defField "pandoc-version" pandocVersion metadata
return $
$ defField "pandoc-version" (T.pack pandocVersion) metadata
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@ -85,7 +83,7 @@ escString :: WriterOptions -> String -> String
escString _ = escapeString AsciiOnly -- for better portability
-- | Return man representation of notes.
notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState m Doc
notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text)
notesToMan opts notes =
if null notes
then return empty
@ -93,7 +91,7 @@ notesToMan opts notes =
return . (text ".SH NOTES" $$) . vcat
-- | Return man representation of a note.
noteToMan :: PandocMonad m => WriterOptions -> Int -> [Block] -> StateT WriterState m Doc
noteToMan :: PandocMonad m => WriterOptions -> Int -> [Block] -> StateT WriterState m (Doc Text)
noteToMan opts num note = do
contents <- blockListToMan opts note
let marker = cr <> text ".SS " <> brackets (text (show num))
@ -107,7 +105,7 @@ noteToMan opts num note = do
blockToMan :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
-> StateT WriterState m Doc
-> StateT WriterState m (Doc Text)
blockToMan _ Null = return empty
blockToMan opts (Div _ bs) = blockListToMan opts bs
blockToMan opts (Plain inlines) =
@ -187,7 +185,7 @@ blockToMan opts (DefinitionList items) = do
return (vcat contents)
-- | Convert bullet list item (list of blocks) to man.
bulletListItemToMan :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Doc
bulletListItemToMan :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToMan _ [] = return empty
bulletListItemToMan opts (Para first:rest) =
bulletListItemToMan opts (Plain first:rest)
@ -210,7 +208,7 @@ orderedListItemToMan :: PandocMonad m
-> String -- ^ order marker for list item
-> Int -- ^ number of spaces to indent
-> [Block] -- ^ list item (list of blocks)
-> StateT WriterState m Doc
-> StateT WriterState m (Doc Text)
orderedListItemToMan _ _ _ [] = return empty
orderedListItemToMan opts num indent (Para first:rest) =
orderedListItemToMan opts num indent (Plain first:rest)
@ -228,7 +226,7 @@ orderedListItemToMan opts num indent (first:rest) = do
definitionListItemToMan :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> StateT WriterState m Doc
-> StateT WriterState m (Doc Text)
definitionListItemToMan opts (label, defs) = do
-- in most man pages, option and other code in option lists is boldface,
-- but not other things, so we try to reproduce this style:
@ -260,16 +258,16 @@ makeCodeBold = walk go
blockListToMan :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
-> StateT WriterState m Doc
-> StateT WriterState m (Doc Text)
blockListToMan opts blocks =
vcat <$> mapM (blockToMan opts) blocks
-- | Convert list of Pandoc inline elements to man.
inlineListToMan :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Doc
inlineListToMan :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan opts lst = hcat <$> mapM (inlineToMan opts) lst
-- | Convert Pandoc inline element to man.
inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m Doc
inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToMan opts (Span _ ils) = inlineListToMan opts ils
inlineToMan opts (Emph lst) =
withFontFeature 'I' (inlineListToMan opts lst)

228
src/Text/Pandoc/Writers/Markdown.hs
View file

@ -20,20 +20,16 @@ module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
import Prelude
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Char (isPunctuation, isSpace, isAlphaNum)
import Data.Char (isSpace, isAlphaNum)
import Data.Default
import qualified Data.HashMap.Strict as H
import Data.List (find, group, intersperse, sortBy, stripPrefix, transpose,
isPrefixOf)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Ord (comparing)
import qualified Data.Set as Set
import qualified Data.Scientific as Scientific
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Aeson (Value (Array, Bool, Number, Object, String))
import Network.HTTP (urlEncode)
import Text.HTML.TagSoup (Tag (..), isTagText, parseTags)
import Text.Pandoc.Class (PandocMonad, report)
@ -41,13 +37,14 @@ import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, blanklines, char, space)
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.DocTemplates (Val(..), Context(..), FromContext(..))
import Text.Pandoc.Walk
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Text.Pandoc.Writers.Math (texMathToInlines)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML (toHtml5Entities)
type Notes = [[Block]]
@ -109,68 +106,82 @@ writePlain :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writePlain opts document =
evalMD (pandocToMarkdown opts document) def{ envPlain = True } def
pandocTitleBlock :: Doc -> [Doc] -> Doc -> Doc
pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock tit auths dat =
hang 2 (text "% ") tit <> cr <>
hang 2 (text "% ") (vcat $ map nowrap auths) <> cr <>
hang 2 (text "% ") dat <> cr
mmdTitleBlock :: Value -> Doc
mmdTitleBlock (Object hashmap) =
vcat $ map go $ sortBy (comparing fst) $ H.toList hashmap
mmdTitleBlock :: Context (Doc Text) -> Doc Text
mmdTitleBlock (Context hashmap) =
vcat $ map go $ sortBy (comparing fst) $ M.toList hashmap
where go (k,v) =
case (text (T.unpack k), v) of
(k', Array vec)
| V.null vec -> empty
(k', ListVal xs)
| null xs -> empty
| otherwise -> k' <> ":" <> space <>
hcat (intersperse "; "
(map fromstr $ V.toList vec))
(_, String "") -> empty
(k', x) -> k' <> ":" <> space <> nest 2 (fromstr x)
fromstr (String s) = text (removeBlankLines $ T.unpack s)
fromstr (Bool b) = text (show b)
fromstr (Number n) = text (show n)
fromstr _ = empty
-- blank lines not allowed in MMD metadata - we replace with .
removeBlankLines = trimr . unlines . map (\x ->
if all isSpace x then "." else x) . lines
mmdTitleBlock _ = empty
hcat (intersperse "; " $
catMaybes $ map fromVal xs)
(k', SimpleVal x)
| isEmpty x -> empty
| otherwise -> k' <> ":" <> space <>
nest 2 (chomp (removeBlankLines x))
_ -> empty
removeBlankLines BlankLines{} = cr <> text "." <> cr
removeBlankLines (Concat x y) = removeBlankLines x <>
removeBlankLines y
removeBlankLines x = x
plainTitleBlock :: Doc -> [Doc] -> Doc -> Doc
plainTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
plainTitleBlock tit auths dat =
tit <> cr <>
(hcat (intersperse (text "; ") auths)) <> cr <>
dat <> cr
yamlMetadataBlock :: Value -> Doc
yamlMetadataBlock v = "---" $$ (jsonToYaml v) $$ "---"
yamlMetadataBlock :: Context (Doc Text) -> Doc Text
yamlMetadataBlock v = "---" $$ (contextToYaml v) $$ "---"
jsonToYaml :: Value -> Doc
jsonToYaml (Object hashmap) =
vcat $ map (\(k,v) ->
case (text (T.unpack k), v, jsonToYaml v) of
(k', Array vec, x)
| V.null vec -> empty
| otherwise -> (k' <> ":") $$ x
(k', Object hm, x)
| H.null hm -> k' <> ": {}"
| otherwise -> (k' <> ":") $$ nest 2 x
(_, String "", _) -> empty
(k', _, x) -> k' <> ":" <> space <> hang 2 "" x)
$ sortBy (comparing fst) $ H.toList hashmap
jsonToYaml (Array vec) =
vcat $ map (\v -> hang 2 "- " (jsonToYaml v)) $ V.toList vec
jsonToYaml (String "") = empty
jsonToYaml (String s) =
case T.unpack s of
x | '\n' `elem` x -> hang 2 ("|" <> cr) $ text x
| not (any isPunctuation x) -> text x
| otherwise -> text $ "'" ++ substitute "'" "''" x ++ "'"
jsonToYaml (Bool b) = text $ show b
jsonToYaml (Number n)
| Scientific.isInteger n = text $ show (floor n :: Integer)
| otherwise = text $ show n
jsonToYaml _ = empty
contextToYaml :: Context (Doc Text) -> Doc Text
contextToYaml (Context o) =
vcat $ map keyvalToYaml $ sortBy (comparing fst) $ M.toList o
where
keyvalToYaml (k,v) =
case (text (T.unpack k), v) of
(k', ListVal vs)
| null vs -> empty
| otherwise -> (k' <> ":") $$ valToYaml v
(k', MapVal (Context m))
| M.null m -> k' <> ": {}"
| otherwise -> (k' <> ":") $$ nest 2 (valToYaml v)
(_, SimpleVal x)
| isEmpty x -> empty
(_, NullVal) -> empty
(k', _) -> k' <> ":" <+> hang 2 "" (valToYaml v)
valToYaml :: Val (Doc Text) -> Doc Text
valToYaml (ListVal xs) =
vcat $ map (\v -> hang 2 "- " (valToYaml v)) xs
valToYaml (MapVal c) = contextToYaml c
valToYaml (SimpleVal x)
| isEmpty x = empty
| otherwise =
if hasNewlines x
then hang 0 ("|" <> cr) x
else if any hasPunct x
then "'" <> fmap escapeSingleQuotes x <> "'"
else x
where
hasNewlines NewLine = True
hasNewlines BlankLines{} = True
hasNewlines CarriageReturn = True
hasNewlines (Concat w z) = hasNewlines w || hasNewlines z
hasNewlines _ = False
hasPunct = T.any isYamlPunct
isYamlPunct = (`elem` ['-','?',':',',','[',']','{','}',
'#','&','*','!','|','>','\'','"',
'%','@','`',',','[',']','{','}'])
escapeSingleQuotes = T.replace "'" "''"
valToYaml _ = empty
-- | Return markdown representation of document.
pandocToMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> MD m Text
@ -179,15 +190,13 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
then Just $ writerColumns opts
else Nothing
isPlain <- asks envPlain
let render' :: Doc -> Text
render' = render colwidth . chomp
metadata <- metaToJSON'
(fmap render' . blockListToMarkdown opts)
(fmap render' . blockToMarkdown opts . Plain)
metadata <- metaToContext'
(blockListToMarkdown opts)
(inlineListToMarkdown opts)
meta
let title' = maybe empty text $ getField "title" metadata
let authors' = maybe [] (map text) $ getField "author" metadata
let date' = maybe empty text $ getField "date" metadata
let title' = maybe empty id $ getField "title" metadata
let authors' = maybe [] id $ getField "author" metadata
let date' = maybe empty id $ getField "date" metadata
let titleblock = case writerTemplate opts of
Just _ | isPlain ->
plainTitleBlock title' authors' date'
@ -201,9 +210,8 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
Nothing -> empty
let headerBlocks = filter isHeaderBlock blocks
toc <- if writerTableOfContents opts
then render' <$> blockToMarkdown opts
( toTableOfContents opts headerBlocks )
else return ""
then blockToMarkdown opts ( toTableOfContents opts headerBlocks )
else return mempty
-- Strip off final 'references' header if markdown citations enabled
let blocks' = if isEnabled Ext_citations opts
then case reverse blocks of
@ -212,7 +220,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
else blocks
body <- blockListToMarkdown opts blocks'
notesAndRefs' <- notesAndRefs opts
let main = render' $ body <> notesAndRefs'
let main = body <> notesAndRefs'
let context = -- for backwards compatibility we populate toc
-- with the contents of the toc, rather than a
-- boolean:
@ -221,22 +229,22 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
$ defField "body" main
$ (if isNullMeta meta
then id
else defField "titleblock" (render' titleblock))
$ addVariablesToJSON opts metadata
return $
else defField "titleblock" titleblock)
$ addVariablesToContext opts metadata
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Return markdown representation of reference key table.
refsToMarkdown :: PandocMonad m => WriterOptions -> Refs -> MD m Doc
refsToMarkdown :: PandocMonad m => WriterOptions -> Refs -> MD m (Doc Text)
refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
-- | Return markdown representation of a reference key.
keyToMarkdown :: PandocMonad m
=> WriterOptions
-> Ref
-> MD m Doc
-> MD m (Doc Text)
keyToMarkdown opts (label', (src, tit), attr) = do
let tit' = if null tit
then empty
@ -246,7 +254,7 @@ keyToMarkdown opts (label', (src, tit), attr) = do
<+> linkAttributes opts attr
-- | Return markdown representation of notes.
notesToMarkdown :: PandocMonad m => WriterOptions -> [[Block]] -> MD m Doc
notesToMarkdown :: PandocMonad m => WriterOptions -> [[Block]] -> MD m (Doc Text)
notesToMarkdown opts notes = do
n <- gets stNoteNum
notes' <- mapM (\(num, note) -> noteToMarkdown opts num note) (zip [n..] notes)
@ -254,7 +262,7 @@ notesToMarkdown opts notes = do
return $ vsep notes'
-- | Return markdown representation of a note.
noteToMarkdown :: PandocMonad m => WriterOptions -> Int -> [Block] -> MD m Doc
noteToMarkdown :: PandocMonad m => WriterOptions -> Int -> [Block] -> MD m (Doc Text)
noteToMarkdown opts num blocks = do
contents <- blockListToMarkdown opts blocks
let num' = text $ writerIdentifierPrefix opts ++ show num
@ -310,7 +318,7 @@ escapeString opts =
_ -> '.':go cs
_ -> c : go cs
attrsToMarkdown :: Attr -> Doc
attrsToMarkdown :: Attr -> Doc Text
attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]
where attribId = case attribs of
([],_,_) -> empty
@ -331,7 +339,7 @@ attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]
escAttrChar '\\' = text "\\\\"
escAttrChar c = text [c]
linkAttributes :: WriterOptions -> Attr -> Doc
linkAttributes :: WriterOptions -> Attr -> Doc Text
linkAttributes opts attr =
if isEnabled Ext_link_attributes opts && attr /= nullAttr
then attrsToMarkdown attr
@ -353,7 +361,7 @@ beginsWithOrderedListMarker str =
Left _ -> False
Right _ -> True
notesAndRefs :: PandocMonad m => WriterOptions -> MD m Doc
notesAndRefs :: PandocMonad m => WriterOptions -> MD m (Doc Text)
notesAndRefs opts = do
notes' <- reverse <$> gets stNotes >>= notesToMarkdown opts
modify $ \s -> s { stNotes = [] }
@ -375,7 +383,7 @@ notesAndRefs opts = do
blockToMarkdown :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
-> MD m Doc
-> MD m (Doc Text)
blockToMarkdown opts blk =
local (\env -> env {envBlockLevel = envBlockLevel env + 1}) $
do doc <- blockToMarkdown' opts blk
@ -387,7 +395,7 @@ blockToMarkdown opts blk =
blockToMarkdown' :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
-> MD m Doc
-> MD m (Doc Text)
blockToMarkdown' _ Null = return empty
blockToMarkdown' opts (Div attrs ils) = do
contents <- blockListToMarkdown opts ils
@ -417,7 +425,7 @@ blockToMarkdown' opts (Plain inlines) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let rendered = render colwidth contents
let rendered = T.unpack $ render colwidth contents
let escapeMarker (x:xs) | x `elem` (".()" :: String) = '\\':x:xs
| otherwise = x : escapeMarker xs
escapeMarker [] = []
@ -624,10 +632,10 @@ blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do
rows
(id,) <$> pipeTable (all null headers) aligns' rawHeaders rawRows
| otherwise -> return $ (id, text "[TABLE]")
return $ nst $ tbl $$ caption'' $$ blankline
return $ nst (tbl $$ caption'') $$ blankline
blockToMarkdown' opts (BulletList items) = do
contents <- inList $ mapM (bulletListItemToMarkdown opts) items
return $ cat contents <> blankline
return $ (if isTightList items then vcat else vsep) contents <> blankline
blockToMarkdown' opts (OrderedList (start,sty,delim) items) = do
let start' = if isEnabled Ext_startnum opts then start else 1
let sty' = if isEnabled Ext_fancy_lists opts then sty else DefaultStyle
@ -640,10 +648,10 @@ blockToMarkdown' opts (OrderedList (start,sty,delim) items) = do
contents <- inList $
mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $
zip markers' items
return $ cat contents <> blankline
return $ (if isTightList items then vcat else vsep) contents <> blankline
blockToMarkdown' opts (DefinitionList items) = do
contents <- inList $ mapM (definitionListItemToMarkdown opts) items
return $ cat contents <> blankline
return $ mconcat contents <> blankline
inList :: Monad m => MD m a -> MD m a
inList p = local (\env -> env {envInList = True}) p
@ -657,7 +665,9 @@ addMarkdownAttribute s =
x /= "markdown"]
_ -> s
pipeTable :: PandocMonad m => Bool -> [Alignment] -> [Doc] -> [[Doc]] -> MD m Doc
pipeTable :: PandocMonad m
=> Bool -> [Alignment] -> [Doc Text] -> [[Doc Text]]
-> MD m (Doc Text)
pipeTable headless aligns rawHeaders rawRows = do
let sp = text " "
let blockFor AlignLeft x y = lblock (x + 2) (sp <> y) <> lblock 0 empty
@ -687,7 +697,7 @@ pipeTable headless aligns rawHeaders rawRows = do
pandocTable :: PandocMonad m
=> WriterOptions -> Bool -> Bool -> [Alignment] -> [Double]
-> [Doc] -> [[Doc]] -> MD m Doc
-> [Doc Text] -> [[Doc Text]] -> MD m (Doc Text)
pandocTable opts multiline headless aligns widths rawHeaders rawRows = do
let isSimple = all (==0) widths
let alignHeader alignment = case alignment of
@ -717,7 +727,7 @@ pandocTable opts multiline headless aligns widths rawHeaders rawRows = do
(zipWith3 alignHeader aligns widthsInChars)
let rows' = map makeRow rawRows
let head' = makeRow rawHeaders
let underline = cat $ intersperse (text " ") $
let underline = mconcat $ intersperse (text " ") $
map (\width -> text (replicate width '-')) widthsInChars
let border = if multiline
then text (replicate (sum widthsInChars +
@ -747,7 +757,7 @@ itemEndsWithTightList bs =
_ -> False
-- | Convert bullet list item (list of blocks) to markdown.
bulletListItemToMarkdown :: PandocMonad m => WriterOptions -> [Block] -> MD m Doc
bulletListItemToMarkdown :: PandocMonad m => WriterOptions -> [Block] -> MD m (Doc Text)
bulletListItemToMarkdown opts bs = do
let exts = writerExtensions opts
contents <- blockListToMarkdown opts $ taskListItemToAscii exts bs
@ -757,14 +767,14 @@ bulletListItemToMarkdown opts bs = do
let contents' = if itemEndsWithTightList bs
then chomp contents <> cr
else contents
return $ hang (writerTabStop opts) start $ contents' <> cr
return $ hang (writerTabStop opts) start $ contents'
-- | Convert ordered list item (a list of blocks) to markdown.
orderedListItemToMarkdown :: PandocMonad m
=> WriterOptions -- ^ options
-> String -- ^ list item marker
-> [Block] -- ^ list item (list of blocks)
-> MD m Doc
-> MD m (Doc Text)
orderedListItemToMarkdown opts marker bs = do
let exts = writerExtensions opts
contents <- blockListToMarkdown opts $ taskListItemToAscii exts bs
@ -779,13 +789,13 @@ orderedListItemToMarkdown opts marker bs = do
let contents' = if itemEndsWithTightList bs
then chomp contents <> cr
else contents
return $ hang ind start $ contents' <> cr
return $ hang ind start $ contents'
-- | Convert definition list item (label, list of blocks) to markdown.
definitionListItemToMarkdown :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> MD m Doc
-> MD m (Doc Text)
definitionListItemToMarkdown opts (label, defs) = do
labelText <- blockToMarkdown opts (Plain label)
defs' <- mapM (mapM (blockToMarkdown opts)) defs
@ -797,17 +807,18 @@ definitionListItemToMarkdown opts (label, defs) = do
let sps = case writerTabStop opts - 3 of
n | n > 0 -> text $ replicate n ' '
_ -> text " "
let isTight = case defs of
((Plain _ : _): _) -> True
_ -> False
if isEnabled Ext_compact_definition_lists opts
then do
let contents = vcat $ map (\d -> hang tabStop (leader <> sps)
$ vcat d <> cr) defs'
return $ nowrap labelText <> cr <> contents <> cr
else do
let contents = vcat $ map (\d -> hang tabStop (leader <> sps)
$ vcat d <> cr) defs'
let isTight = case defs of
((Plain _ : _): _) -> True
_ -> False
let contents = (if isTight then vcat else vsep) $ map
(\d -> hang tabStop (leader <> sps) $ vcat d)
defs'
return $ blankline <> nowrap labelText $$
(if isTight then empty else blankline) <> contents <> blankline
else do
@ -818,7 +829,7 @@ definitionListItemToMarkdown opts (label, defs) = do
blockListToMarkdown :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
-> MD m Doc
-> MD m (Doc Text)
blockListToMarkdown opts blocks = do
inlist <- asks envInList
isPlain <- asks envPlain
@ -860,10 +871,10 @@ blockListToMarkdown opts blocks = do
else if isEnabled Ext_raw_html opts
then RawBlock "html" "<!-- -->\n"
else RawBlock "markdown" "&nbsp;\n"
mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat
mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . mconcat
getKey :: Doc -> Key
getKey = toKey . render Nothing
getKey :: Doc Text -> Key
getKey = toKey . T.unpack . render Nothing
findUsableIndex :: [String] -> Int -> Int
findUsableIndex lbls i = if (show i) `elem` lbls
@ -880,7 +891,7 @@ getNextIndex = do
-- | Get reference for target; if none exists, create unique one and return.
-- Prefer label if possible; otherwise, generate a unique key.
getReference :: PandocMonad m => Attr -> Doc -> Target -> MD m String
getReference :: PandocMonad m => Attr -> Doc Text -> Target -> MD m String
getReference attr label target = do
refs <- gets stRefs
case find (\(_,t,a) -> t == target && a == attr) refs of
@ -894,7 +905,8 @@ getReference attr label target = do
i <- getNextIndex
modify $ \s -> s{ stLastIdx = i }
return (show i, i)
else return (render Nothing label, 0)
else
return (T.unpack (render Nothing label), 0)
modify (\s -> s{
stRefs = (lab', target, attr) : refs,
stKeys = M.insert (getKey label)
@ -905,7 +917,7 @@ getReference attr label target = do
Just km -> do -- we have refs with this label
case M.lookup (target, attr) km of
Just i -> do
let lab' = render Nothing $
let lab' = T.unpack $ render Nothing $
label <> if i == 0
then mempty
else text (show i)
@ -928,7 +940,7 @@ getReference attr label target = do
return lab'
-- | Convert list of Pandoc inline elements to markdown.
inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m Doc
inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m (Doc Text)
inlineListToMarkdown opts lst = do
inlist <- asks envInList
go (if inlist then avoidBadWrapsInList lst else lst)
@ -998,7 +1010,7 @@ isRight (Right _) = True
isRight (Left _) = False
-- | Convert Pandoc inline element to markdown.
inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m Doc
inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m (Doc Text)
inlineToMarkdown opts (Span ("",["emoji"],kvs) [Str s]) = do
case lookup "data-emoji" kvs of
Just emojiname | isEnabled Ext_emoji opts ->
@ -1051,7 +1063,7 @@ inlineToMarkdown opts (Superscript lst) =
else if isEnabled Ext_raw_html opts
then "<sup>" <> contents <> "</sup>"
else
let rendered = render Nothing contents
let rendered = T.unpack $ render Nothing contents
in case mapM toSuperscript rendered of
Just r -> text r
Nothing -> text $ "^(" ++ rendered ++ ")"
@ -1064,7 +1076,7 @@ inlineToMarkdown opts (Subscript lst) =
else if isEnabled Ext_raw_html opts
then "<sub>" <> contents <> "</sub>"
else
let rendered = render Nothing contents
let rendered = T.unpack $ render Nothing contents
in case mapM toSubscript rendered of
Just r -> text r
Nothing -> text $ "_(" ++ rendered ++ ")"

10
src/Text/Pandoc/Writers/MediaWiki.hs
View file

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

55
src/Text/Pandoc/Writers/Ms.hs
View file

@ -37,9 +37,9 @@ import Text.Pandoc.Highlighting
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Writers.Roff
@ -57,14 +57,11 @@ pandocToMs opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON opts
(fmap render' . blockListToMs opts)
(fmap render' . inlineListToMs' opts)
metadata <- metaToContext opts
(blockListToMs opts)
(fmap chomp . inlineListToMs' opts)
meta
body <- blockListToMs opts blocks
let main = render' body
main <- blockListToMs opts blocks
hasInlineMath <- gets stHasInlineMath
let titleMeta = (escapeStr opts . stringify) $ docTitle meta
let authorsMeta = map (escapeStr opts . stringify) $ docAuthors meta
@ -72,18 +69,18 @@ pandocToMs opts (Pandoc meta blocks) = do
let highlightingMacros = if hasHighlighting
then case writerHighlightStyle opts of
Nothing -> mempty
Just sty -> render' $ styleToMs sty
Just sty -> styleToMs sty
else mempty
let context = defField "body" main
$ defField "has-inline-math" hasInlineMath
$ defField "hyphenate" True
$ defField "pandoc-version" pandocVersion
$ defField "pandoc-version" (T.pack pandocVersion)
$ defField "toc" (writerTableOfContents opts)
$ defField "title-meta" titleMeta
$ defField "author-meta" (intercalate "; " authorsMeta)
$ defField "title-meta" (T.pack titleMeta)
$ defField "author-meta" (T.pack $ intercalate "; " authorsMeta)
$ defField "highlighting-macros" highlightingMacros metadata
return $
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@ -112,7 +109,7 @@ toSmallCaps opts (c:cs)
blockToMs :: PandocMonad m
=> WriterOptions -- ^ Options
-> Block -- ^ Block element
-> MS m Doc
-> MS m (Doc Text)
blockToMs _ Null = return empty
blockToMs opts (Div (ident,_,_) bs) = do
let anchor = if null ident
@ -264,7 +261,7 @@ blockToMs opts (DefinitionList items) = do
return (vcat contents)
-- | Convert bullet list item (list of blocks) to ms.
bulletListItemToMs :: PandocMonad m => WriterOptions -> [Block] -> MS m Doc
bulletListItemToMs :: PandocMonad m => WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs _ [] = return empty
bulletListItemToMs opts (Para first:rest) =
bulletListItemToMs opts (Plain first:rest)
@ -287,7 +284,7 @@ orderedListItemToMs :: PandocMonad m
-> String -- ^ order marker for list item
-> Int -- ^ number of spaces to indent
-> [Block] -- ^ list item (list of blocks)
-> MS m Doc
-> MS m (Doc Text)
orderedListItemToMs _ _ _ [] = return empty
orderedListItemToMs opts num indent (Para first:rest) =
orderedListItemToMs opts num indent (Plain first:rest)
@ -306,7 +303,7 @@ orderedListItemToMs opts num indent (first:rest) = do
definitionListItemToMs :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> MS m Doc
-> MS m (Doc Text)
definitionListItemToMs opts (label, defs) = do
labelText <- inlineListToMs' opts $ map breakToSpace label
contents <- if null defs
@ -327,26 +324,26 @@ definitionListItemToMs opts (label, defs) = do
blockListToMs :: PandocMonad m
=> WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
-> MS m Doc
-> MS m (Doc Text)
blockListToMs opts blocks =
vcat <$> mapM (blockToMs opts) blocks
-- | Convert list of Pandoc inline elements to ms.
inlineListToMs :: PandocMonad m => WriterOptions -> [Inline] -> MS m Doc
inlineListToMs :: PandocMonad m => WriterOptions -> [Inline] -> MS m (Doc Text)
-- if list starts with ., insert a zero-width character \& so it
-- won't be interpreted as markup if it falls at the beginning of a line.
inlineListToMs opts lst = hcat <$> mapM (inlineToMs opts) lst
-- This version to be used when there is no further inline content;
-- forces a note at the end.
inlineListToMs' :: PandocMonad m => WriterOptions -> [Inline] -> MS m Doc
inlineListToMs' :: PandocMonad m => WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' opts lst = do
x <- hcat <$> mapM (inlineToMs opts) lst
y <- handleNotes opts empty
return $ x <> y
-- | Convert Pandoc inline element to ms.
inlineToMs :: PandocMonad m => WriterOptions -> Inline -> MS m Doc
inlineToMs :: PandocMonad m => WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs opts (Span _ ils) = inlineListToMs opts ils
inlineToMs opts (Emph lst) =
withFontFeature 'I' (inlineListToMs opts lst)
@ -382,7 +379,7 @@ inlineToMs opts (Code attr str) = do
withFontFeature 'C' (return hlCode)
inlineToMs opts (Str str) = do
let shim = case str of
'.':_ -> afterBreak "\\&"
'.':_ -> afterBreak (T.pack "\\&")
_ -> empty
smallcaps <- gets stSmallCaps
if smallcaps
@ -437,7 +434,7 @@ inlineToMs _ (Note contents) = do
modify $ \st -> st{ stNotes = contents : stNotes st }
return $ text "\\**"
handleNotes :: PandocMonad m => WriterOptions -> Doc -> MS m Doc
handleNotes :: PandocMonad m => WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes opts fallback = do
notes <- gets stNotes
if null notes
@ -446,7 +443,7 @@ handleNotes opts fallback = do
modify $ \st -> st{ stNotes = [] }
vcat <$> mapM (handleNote opts) notes
handleNote :: PandocMonad m => WriterOptions -> Note -> MS m Doc
handleNote :: PandocMonad m => WriterOptions -> Note -> MS m (Doc Text)
handleNote opts bs = do
-- don't start with Paragraph or we'll get a spurious blank
-- line after the note ref:
@ -469,7 +466,7 @@ breakToSpace x = x
-- Highlighting
styleToMs :: Style -> Doc
styleToMs :: Style -> Doc Text
styleToMs sty = vcat $ colordefs ++ map (toMacro sty) alltoktypes
where alltoktypes = enumFromTo KeywordTok NormalTok
colordefs = map toColorDef allcolors
@ -484,7 +481,7 @@ styleToMs sty = vcat $ colordefs ++ map (toMacro sty) alltoktypes
hexColor :: Color -> String
hexColor (RGB r g b) = printf "%02x%02x%02x" r g b
toMacro :: Style -> TokenType -> Doc
toMacro :: Style -> TokenType -> Doc Text
toMacro sty toktype =
nowrap (text ".ds " <> text (show toktype) <> text " " <>
setbg <> setcolor <> setfont <>
@ -512,7 +509,7 @@ toMacro sty toktype =
-- lnColor = lineNumberColor sty
-- lnBkgColor = lineNumberBackgroundColor sty
msFormatter :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc
msFormatter :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
msFormatter opts _fmtopts =
vcat . map fmtLine
where fmtLine = hcat . map fmtToken
@ -520,7 +517,7 @@ msFormatter opts _fmtopts =
brackets (text (show toktype) <> text " \""
<> text (escapeStr opts (T.unpack tok)) <> text "\"")
highlightCode :: PandocMonad m => WriterOptions -> Attr -> String -> MS m Doc
highlightCode :: PandocMonad m => WriterOptions -> Attr -> String -> MS m (Doc Text)
highlightCode opts attr str =
case highlight (writerSyntaxMap opts) (msFormatter opts) attr str of
Left msg -> do

56
src/Text/Pandoc/Writers/Muse.hs
View file

@ -32,13 +32,14 @@ import Data.Char (isAlphaNum, isAsciiLower, isAsciiUpper, isDigit, isSpace)
import Data.Default
import Data.List (intersperse, isInfixOf, transpose)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text (Text)
import System.FilePath (takeExtension)
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math
@ -104,17 +105,15 @@ pandocToMuse (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render Nothing
metadata <- metaToJSON opts
(fmap render' . blockListToMuse)
(fmap render' . inlineListToMuse)
metadata <- metaToContext opts
blockListToMuse
(fmap chomp . inlineListToMuse)
meta
body <- blockListToMuse blocks
notes <- currentNotesToMuse
let main = render colwidth $ body $+$ notes
let main = body $+$ notes
let context = defField "body" main metadata
return $
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@ -124,7 +123,7 @@ pandocToMuse (Pandoc meta blocks) = do
catWithBlankLines :: PandocMonad m
=> [Block] -- ^ List of block elements
-> Int -- ^ Number of blank lines
-> Muse m Doc
-> Muse m (Doc Text)
catWithBlankLines (b : bs) n = do
b' <- blockToMuseWithNotes b
bs' <- flatBlockListToMuse bs
@ -135,7 +134,7 @@ catWithBlankLines _ _ = error "Expected at least one block"
-- | without setting envTopLevel.
flatBlockListToMuse :: PandocMonad m
=> [Block] -- ^ List of block elements
-> Muse m Doc
-> Muse m (Doc Text)
flatBlockListToMuse bs@(BulletList _ : BulletList _ : _) = catWithBlankLines bs 2
flatBlockListToMuse bs@(OrderedList (_, style1, _) _ : OrderedList (_, style2, _) _ : _) =
catWithBlankLines bs (if style1' == style2' then 2 else 0)
@ -152,7 +151,7 @@ simpleTable :: PandocMonad m
=> [Inline]
-> [TableCell]
-> [[TableCell]]
-> Muse m Doc
-> Muse m (Doc Text)
simpleTable caption headers rows = do
topLevel <- asks envTopLevel
caption' <- inlineListToMuse caption
@ -175,7 +174,7 @@ simpleTable caption headers rows = do
-- | Convert list of Pandoc block elements to Muse.
blockListToMuse :: PandocMonad m
=> [Block] -- ^ List of block elements
-> Muse m Doc
-> Muse m (Doc Text)
blockListToMuse =
local (\env -> env { envTopLevel = not (envInsideBlock env)
, envInsideBlock = True
@ -184,7 +183,7 @@ blockListToMuse =
-- | Convert Pandoc block element to Muse.
blockToMuse :: PandocMonad m
=> Block -- ^ Block element
-> Muse m Doc
-> Muse m (Doc Text)
blockToMuse (Plain inlines) = inlineListToMuse' inlines
blockToMuse (Para inlines) = do
contents <- inlineListToMuse' inlines
@ -213,7 +212,7 @@ blockToMuse (OrderedList (start, style, _) items) = do
where orderedListItemToMuse :: PandocMonad m
=> String -- ^ marker for list item
-> [Block] -- ^ list item (list of blocks)
-> Muse m Doc
-> Muse m (Doc Text)
orderedListItemToMuse marker item = hang (length marker + 1) (text marker <> space)
<$> blockListToMuse item
blockToMuse (BulletList items) = do
@ -222,7 +221,7 @@ blockToMuse (BulletList items) = do
return $ (if topLevel then nest 1 else id) (vcat contents) $$ blankline
where bulletListItemToMuse :: PandocMonad m
=> [Block]
-> Muse m Doc
-> Muse m (Doc Text)
bulletListItemToMuse item = do
modify $ \st -> st { stUseTags = False }
hang 2 "- " <$> blockListToMuse item
@ -232,16 +231,17 @@ blockToMuse (DefinitionList items) = do
return $ (if topLevel then nest 1 else id) (vcat contents) $$ blankline
where definitionListItemToMuse :: PandocMonad m
=> ([Inline], [[Block]])
-> Muse m Doc
-> Muse m (Doc Text)
definitionListItemToMuse (label, defs) = do
modify $ \st -> st { stUseTags = False }
label' <- local (\env -> env { envOneLine = True, envAfterSpace = True }) $ inlineListToMuse' label
let ind = offset' label' -- using Text.Pandoc.Pretty.offset results in round trip failures
let ind = offset' label' -- using Text.DocLayout.offset results in round trip failures
hang ind (nowrap label') . vcat <$> mapM descriptionToMuse defs
where offset' d = maximum (0: map length (lines $ render Nothing d))
where offset' d = maximum (0: map T.length
(T.lines $ render Nothing d))
descriptionToMuse :: PandocMonad m
=> [Block]
-> Muse m Doc
-> Muse m (Doc Text)
descriptionToMuse desc = hang 4 " :: " <$> blockListToMuse desc
blockToMuse (Header level (ident,_,_) inlines) = do
opts <- asks envOptions
@ -274,7 +274,7 @@ blockToMuse Null = return empty
-- | Return Muse representation of notes collected so far.
currentNotesToMuse :: PandocMonad m
=> Muse m Doc
=> Muse m (Doc Text)
currentNotesToMuse = do
notes <- reverse <$> gets stNotes
modify $ \st -> st { stNotes = mempty }
@ -283,7 +283,7 @@ currentNotesToMuse = do
-- | Return Muse representation of notes.
notesToMuse :: PandocMonad m
=> Notes
-> Muse m Doc
-> Muse m (Doc Text)
notesToMuse notes = do
n <- gets stNoteNum
modify $ \st -> st { stNoteNum = stNoteNum st + length notes }
@ -293,7 +293,7 @@ notesToMuse notes = do
noteToMuse :: PandocMonad m
=> Int
-> [Block]
-> Muse m Doc
-> Muse m (Doc Text)
noteToMuse num note = do
res <- hang (length marker) (text marker) <$>
local (\env -> env { envInsideBlock = True
@ -307,7 +307,7 @@ noteToMuse num note = do
-- | Return Muse representation of block and accumulated notes.
blockToMuseWithNotes :: PandocMonad m
=> Block
-> Muse m Doc
-> Muse m (Doc Text)
blockToMuseWithNotes blk = do
topLevel <- asks envTopLevel
opts <- asks envOptions
@ -501,7 +501,7 @@ inlineListStartsWithAlnum _ = return False
-- | Convert list of Pandoc inline elements to Muse
renderInlineList :: PandocMonad m
=> [Inline]
-> Muse m Doc
-> Muse m (Doc Text)
renderInlineList [] = pure ""
renderInlineList (x:xs) = do
start <- asks envInlineStart
@ -531,7 +531,7 @@ renderInlineList (x:xs) = do
-- | Normalize and convert list of Pandoc inline elements to Muse.
inlineListToMuse :: PandocMonad m
=> [Inline]
-> Muse m Doc
-> Muse m (Doc Text)
inlineListToMuse lst = do
lst' <- normalizeInlineList . fixNotes <$> preprocessInlineList (map (removeKeyValues . replaceSmallCaps) lst)
insideAsterisks <- asks envInsideAsterisks
@ -541,7 +541,7 @@ inlineListToMuse lst = do
then pure "<verbatim></verbatim>"
else local (\env -> env { envNearAsterisks = insideAsterisks }) $ renderInlineList lst'
inlineListToMuse' :: PandocMonad m => [Inline] -> Muse m Doc
inlineListToMuse' :: PandocMonad m => [Inline] -> Muse m (Doc Text)
inlineListToMuse' lst = do
topLevel <- asks envTopLevel
afterSpace <- asks envAfterSpace
@ -549,7 +549,7 @@ inlineListToMuse' lst = do
, envAfterSpace = afterSpace || not topLevel
}) $ inlineListToMuse lst
emphasis :: PandocMonad m => String -> String -> [Inline] -> Muse m Doc
emphasis :: PandocMonad m => String -> String -> [Inline] -> Muse m (Doc Text)
emphasis b e lst = do
contents <- local (\env -> env { envInsideAsterisks = inAsterisks }) $ inlineListToMuse lst
modify $ \st -> st { stUseTags = useTags }
@ -560,7 +560,7 @@ emphasis b e lst = do
-- | Convert Pandoc inline element to Muse.
inlineToMuse :: PandocMonad m
=> Inline
-> Muse m Doc
-> Muse m (Doc Text)
inlineToMuse (Str str) = do
escapedStr <- conditionalEscapeString $ replaceNewlines str
let useTags = isAlphaNum $ last escapedStr -- escapedStr is never empty because empty strings are escaped

8
src/Text/Pandoc/Writers/Native.hs
View file

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

2
src/Text/Pandoc/Writers/ODT.hs
View file

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

12
src/Text/Pandoc/Writers/OPML.hs
View file

@ -14,7 +14,7 @@ Conversion of 'Pandoc' documents to OPML XML.
module Text.Pandoc.Writers.OPML ( writeOPML) where
import Prelude
import Control.Monad.Except (throwError)
import Data.Text (Text, unpack)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad)
@ -22,7 +22,7 @@ import Data.Time
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.HTML (writeHtml5String)
@ -38,7 +38,7 @@ writeOPML opts (Pandoc meta blocks) = do
then Just $ writerColumns opts
else Nothing
meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta
metadata <- metaToJSON opts
metadata <- metaToContext opts
(writeMarkdown def . Pandoc nullMeta)
(\ils -> T.stripEnd <$> writeMarkdown def (Pandoc nullMeta [Plain ils]))
meta'
@ -64,7 +64,7 @@ convertDate ils = maybe "" showDateTimeRFC822 $
parseTimeM True defaultTimeLocale "%F" =<< normalizeDate (stringify ils)
-- | Convert an Element to OPML.
elementToOPML :: PandocMonad m => WriterOptions -> Element -> m Doc
elementToOPML :: PandocMonad m => WriterOptions -> Element -> m (Doc Text)
elementToOPML _ (Blk _) = return empty
elementToOPML opts (Sec _ _num _ title elements) = do
let isBlk :: Element -> Bool
@ -81,7 +81,7 @@ elementToOPML opts (Sec _ _num _ title elements) = do
then return mempty
else do blks <- mapM fromBlk blocks
writeMarkdown def $ Pandoc nullMeta blks
let attrs = ("text", unpack htmlIls) :
[("_note", unpack md) | not (null blocks)]
let attrs = ("text", T.unpack htmlIls) :
[("_note", T.unpack $ T.stripEnd md) | not (null blocks)]
o <- mapM (elementToOPML opts) rest
return $ inTags True "outline" attrs $ vcat o

107
src/Text/Pandoc/Writers/OpenDocument.hs
View file

@ -30,7 +30,7 @@ import Text.Pandoc.Class (PandocMonad, report, translateTerm,
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared (linesToPara)
import Text.Pandoc.Templates (renderTemplate)
import qualified Text.Pandoc.Translations as Term (Term(Figure, Table))
@ -51,11 +51,12 @@ plainToPara x = x
type OD m = StateT WriterState m
data WriterState =
WriterState { stNotes :: [Doc]
, stTableStyles :: [Doc]
, stParaStyles :: [Doc]
, stListStyles :: [(Int, [Doc])]
, stTextStyles :: Map.Map (Set.Set TextStyle) (String, Doc)
WriterState { stNotes :: [Doc Text]
, stTableStyles :: [Doc Text]
, stParaStyles :: [Doc Text]
, stListStyles :: [(Int, [Doc Text])]
, stTextStyles :: Map.Map (Set.Set TextStyle)
(String, Doc Text)
, stTextStyleAttr :: Set.Set TextStyle
, stIndentPara :: Int
, stInDefinition :: Bool
@ -83,19 +84,20 @@ defaultWriterState =
, stImageCaptionId = 1
}
when :: Bool -> Doc -> Doc
when :: Bool -> Doc Text -> Doc Text
when p a = if p then a else empty
addTableStyle :: PandocMonad m => Doc -> OD m ()
addTableStyle :: PandocMonad m => Doc Text -> OD m ()
addTableStyle i = modify $ \s -> s { stTableStyles = i : stTableStyles s }
addNote :: PandocMonad m => Doc -> OD m ()
addNote :: PandocMonad m => Doc Text -> OD m ()
addNote i = modify $ \s -> s { stNotes = i : stNotes s }
addParaStyle :: PandocMonad m => Doc -> OD m ()
addParaStyle :: PandocMonad m => Doc Text -> OD m ()
addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s }
addTextStyle :: PandocMonad m => Set.Set TextStyle -> (String, Doc) -> OD m ()
addTextStyle :: PandocMonad m
=> Set.Set TextStyle -> (String, Doc Text) -> OD m ()
addTextStyle attrs i = modify $ \s ->
s { stTextStyles = Map.insert attrs i (stTextStyles s) }
@ -119,7 +121,7 @@ setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
setFirstPara :: PandocMonad m => OD m ()
setFirstPara = modify $ \s -> s { stFirstPara = True }
inParagraphTags :: PandocMonad m => Doc -> OD m Doc
inParagraphTags :: PandocMonad m => Doc Text -> OD m (Doc Text)
inParagraphTags d = do
b <- gets stFirstPara
a <- if b
@ -128,10 +130,10 @@ inParagraphTags d = do
else return [("text:style-name", "Text_20_body")]
return $ inTags False "text:p" a d
inParagraphTagsWithStyle :: String -> Doc -> Doc
inParagraphTagsWithStyle :: String -> Doc Text -> Doc Text
inParagraphTagsWithStyle sty = inTags False "text:p" [("text:style-name", sty)]
inSpanTags :: String -> Doc -> Doc
inSpanTags :: String -> Doc Text -> Doc Text
inSpanTags s = inTags False "text:span" [("text:style-name",s)]
withTextStyle :: PandocMonad m => TextStyle -> OD m a -> OD m a
@ -142,7 +144,7 @@ withTextStyle s f = do
modify $ \st -> st{ stTextStyleAttr = oldTextStyleAttr }
return res
inTextStyle :: PandocMonad m => Doc -> OD m Doc
inTextStyle :: PandocMonad m => Doc Text -> OD m (Doc Text)
inTextStyle d = do
at <- gets stTextStyleAttr
if Set.null at
@ -164,10 +166,10 @@ inTextStyle d = do
return $ inTags False
"text:span" [("text:style-name",styleName)] d
formulaStyles :: [Doc]
formulaStyles :: [Doc Text]
formulaStyles = [formulaStyle InlineMath, formulaStyle DisplayMath]
formulaStyle :: MathType -> Doc
formulaStyle :: MathType -> Doc Text
formulaStyle mt = inTags False "style:style"
[("style:name", if mt == InlineMath then "fr1" else "fr2")
,("style:family", "graphic")
@ -182,7 +184,7 @@ formulaStyle mt = inTags False "style:style"
,("style:horizontal-rel", "paragraph-content")
,("style:wrap", "none")]
inHeaderTags :: PandocMonad m => Int -> String -> Doc -> OD m Doc
inHeaderTags :: PandocMonad m => Int -> String -> Doc Text -> OD m (Doc Text)
inHeaderTags i ident d =
return $ inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i)
, ("text:outline-level", show i)]
@ -192,11 +194,11 @@ inHeaderTags i ident d =
<> d <>
selfClosingTag "text:bookmark-end" [ ("text:name", ident) ]
inQuotes :: QuoteType -> Doc -> Doc
inQuotes :: QuoteType -> Doc Text -> Doc Text
inQuotes SingleQuote s = char '\8216' <> s <> char '\8217'
inQuotes DoubleQuote s = char '\8220' <> s <> char '\8221'
handleSpaces :: String -> Doc
handleSpaces :: String -> Doc Text
handleSpaces s
| ( ' ':_) <- s = genTag s
| ('\t':x) <- s = selfClosingTag "text:tab" [] <> rm x
@ -220,15 +222,13 @@ writeOpenDocument opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
((body, metadata),s) <- flip runStateT
defaultWriterState $ do
m <- metaToJSON opts
(fmap render' . blocksToOpenDocument opts)
(fmap render' . inlinesToOpenDocument opts)
m <- metaToContext opts
(blocksToOpenDocument opts)
(fmap chomp . inlinesToOpenDocument opts)
meta
b <- render' `fmap` blocksToOpenDocument opts blocks
b <- blocksToOpenDocument opts blocks
return (b, m)
let styles = stTableStyles s ++ stParaStyles s ++ formulaStyles ++
map snd (sortBy (flip (comparing fst)) (
@ -239,33 +239,34 @@ writeOpenDocument opts (Pandoc meta blocks) = do
let automaticStyles = vcat $ reverse $ styles ++ listStyles
let context = defField "body" body
$ defField "toc" (writerTableOfContents opts)
$defField "automatic-styles" (render' automaticStyles) metadata
return $
$ defField "automatic-styles" automaticStyles
$ metadata
return $ render colwidth $
case writerTemplate opts of
Nothing -> body
Just tpl -> renderTemplate tpl context
withParagraphStyle :: PandocMonad m
=> WriterOptions -> String -> [Block] -> OD m Doc
=> WriterOptions -> String -> [Block] -> OD m (Doc Text)
withParagraphStyle o s (b:bs)
| Para l <- b = go =<< inParagraphTagsWithStyle s <$> inlinesToOpenDocument o l
| otherwise = go =<< blockToOpenDocument o b
where go i = (<>) i <$> withParagraphStyle o s bs
withParagraphStyle _ _ [] = return empty
inPreformattedTags :: PandocMonad m => String -> OD m Doc
inPreformattedTags :: PandocMonad m => String -> OD m (Doc Text)
inPreformattedTags s = do
n <- paraStyle [("style:parent-style-name","Preformatted_20_Text")]
return . inParagraphTagsWithStyle ("P" ++ show n) . handleSpaces $ s
orderedListToOpenDocument :: PandocMonad m
=> WriterOptions -> Int -> [[Block]] -> OD m Doc
=> WriterOptions -> Int -> [[Block]] -> OD m (Doc Text)
orderedListToOpenDocument o pn bs =
vcat . map (inTagsIndented "text:list-item") <$>
mapM (orderedItemToOpenDocument o pn . map plainToPara) bs
orderedItemToOpenDocument :: PandocMonad m
=> WriterOptions -> Int -> [Block] -> OD m Doc
=> WriterOptions -> Int -> [Block] -> OD m (Doc Text)
orderedItemToOpenDocument o n bs = vcat <$> mapM go bs
where go (OrderedList a l) = newLevel a l
go (Para l) = inParagraphTagsWithStyle ("P" ++ show n) <$>
@ -294,7 +295,7 @@ newOrderedListStyle b a = do
return (ln,pn)
bulletListToOpenDocument :: PandocMonad m
=> WriterOptions -> [[Block]] -> OD m Doc
=> WriterOptions -> [[Block]] -> OD m (Doc Text)
bulletListToOpenDocument o b = do
ln <- (+) 1 . length <$> gets stListStyles
(pn,ns) <- if isTightList b then inTightList (bulletListStyle ln) else bulletListStyle ln
@ -303,12 +304,12 @@ bulletListToOpenDocument o b = do
return $ inTags True "text:list" [("text:style-name", "L" ++ show ln)] is
listItemsToOpenDocument :: PandocMonad m
=> String -> WriterOptions -> [[Block]] -> OD m Doc
=> String -> WriterOptions -> [[Block]] -> OD m (Doc Text)
listItemsToOpenDocument s o is =
vcat . map (inTagsIndented "text:list-item") <$> mapM (withParagraphStyle o s . map plainToPara) is
deflistItemToOpenDocument :: PandocMonad m
=> WriterOptions -> ([Inline],[[Block]]) -> OD m Doc
=> WriterOptions -> ([Inline],[[Block]]) -> OD m (Doc Text)
deflistItemToOpenDocument o (t,d) = do
let ts = if isTightList d
then "Definition_20_Term_20_Tight" else "Definition_20_Term"
@ -319,7 +320,7 @@ deflistItemToOpenDocument o (t,d) = do
return $ t' $$ d'
inBlockQuote :: PandocMonad m
=> WriterOptions -> Int -> [Block] -> OD m Doc
=> WriterOptions -> Int -> [Block] -> OD m (Doc Text)
inBlockQuote o i (b:bs)
| BlockQuote l <- b = do increaseIndent
ni <- paraStyle
@ -331,11 +332,11 @@ inBlockQuote o i (b:bs)
inBlockQuote _ _ [] = resetIndent >> return empty
-- | Convert a list of Pandoc blocks to OpenDocument.
blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m Doc
blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument o b = vcat <$> mapM (blockToOpenDocument o) b
-- | Convert a Pandoc block element to OpenDocument.
blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m Doc
blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument o bs
| Plain b <- bs = if null b
then return empty
@ -417,21 +418,21 @@ blockToOpenDocument o bs
return $ imageDoc $$ captionDoc
numberedTableCaption :: PandocMonad m => Doc -> OD m Doc
numberedTableCaption :: PandocMonad m => Doc Text -> OD m (Doc Text)
numberedTableCaption caption = do
id' <- gets stTableCaptionId
modify (\st -> st{ stTableCaptionId = id' + 1 })
capterm <- translateTerm Term.Table
return $ numberedCaption "Table" capterm "Table" id' caption
numberedFigureCaption :: PandocMonad m => Doc -> OD m Doc
numberedFigureCaption :: PandocMonad m => Doc Text -> OD m (Doc Text)
numberedFigureCaption caption = do
id' <- gets stImageCaptionId
modify (\st -> st{ stImageCaptionId = id' + 1 })
capterm <- translateTerm Term.Figure
return $ numberedCaption "FigureCaption" capterm "Illustration" id' caption
numberedCaption :: String -> String -> String -> Int -> Doc -> Doc
numberedCaption :: String -> String -> String -> Int -> Doc Text -> Doc Text
numberedCaption style term name num caption =
let t = text term
r = num - 1
@ -442,26 +443,26 @@ numberedCaption style term name num caption =
c = text ": "
in inParagraphTagsWithStyle style $ hcat [ t, text " ", s, c, caption ]
unNumberedCaption :: Monad m => String -> Doc -> OD m Doc
unNumberedCaption :: Monad m => String -> Doc Text -> OD m (Doc Text)
unNumberedCaption style caption = return $ inParagraphTagsWithStyle style caption
colHeadsToOpenDocument :: PandocMonad m
=> WriterOptions -> [String] -> [[Block]]
-> OD m Doc
-> OD m (Doc Text)
colHeadsToOpenDocument o ns hs =
inTagsIndented "table:table-header-rows" . inTagsIndented "table:table-row" . vcat <$>
mapM (tableItemToOpenDocument o "TableHeaderRowCell") (zip ns hs)
tableRowToOpenDocument :: PandocMonad m
=> WriterOptions -> [String] -> [[Block]]
-> OD m Doc
-> OD m (Doc Text)
tableRowToOpenDocument o ns cs =
inTagsIndented "table:table-row" . vcat <$>
mapM (tableItemToOpenDocument o "TableRowCell") (zip ns cs)
tableItemToOpenDocument :: PandocMonad m
=> WriterOptions -> String -> (String,[Block])
-> OD m Doc
-> OD m (Doc Text)
tableItemToOpenDocument o s (n,i) =
let a = [ ("table:style-name" , s )
, ("office:value-type", "string" )
@ -470,10 +471,10 @@ tableItemToOpenDocument o s (n,i) =
withParagraphStyle o n (map plainToPara i)
-- | Convert a list of inline elements to OpenDocument.
inlinesToOpenDocument :: PandocMonad m => WriterOptions -> [Inline] -> OD m Doc
inlinesToOpenDocument :: PandocMonad m => WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument o l = hcat <$> toChunks o l
toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc]
toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks _ [] = return []
toChunks o (x : xs)
| isChunkable x = do
@ -494,7 +495,7 @@ isChunkable SoftBreak = True
isChunkable _ = False
-- | Convert an inline element to OpenDocument.
inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m Doc
inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument o ils
= case ils of
Space -> return space
@ -557,7 +558,7 @@ inlineToOpenDocument o ils
addNote nn
return nn
bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc]))
bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc Text]))
bulletListStyle l = do
let doStyles i = inTags True "text:list-level-style-bullet"
[ ("text:level" , show (i + 1) )
@ -570,7 +571,7 @@ bulletListStyle l = do
pn <- paraListStyle l
return (pn, (l, listElStyle))
orderedListLevelStyle :: ListAttributes -> (Int, [Doc]) -> (Int,[Doc])
orderedListLevelStyle :: ListAttributes -> (Int, [Doc Text]) -> (Int,[Doc Text])
orderedListLevelStyle (s,n, d) (l,ls) =
let suffix = case d of
OneParen -> [("style:num-suffix", ")")]
@ -591,7 +592,7 @@ orderedListLevelStyle (s,n, d) (l,ls) =
] ++ suffix) (listLevelStyle (1 + length ls))
in (l, ls ++ [listStyle])
listLevelStyle :: Int -> Doc
listLevelStyle :: Int -> Doc Text
listLevelStyle i =
let indent = show (0.25 + (0.25 * fromIntegral i :: Double)) in
inTags True "style:list-level-properties"
@ -606,7 +607,7 @@ listLevelStyle i =
, ("fo:margin-left", indent ++ "in")
]
tableStyle :: Int -> [(Char,Double)] -> Doc
tableStyle :: Int -> [(Char,Double)] -> Doc Text
tableStyle num wcs =
let tableId = "Table" ++ show (num + 1)
table = inTags True "style:style"
@ -669,7 +670,7 @@ paraListStyle l = paraStyle
[("style:parent-style-name","Text_20_body")
,("style:list-style-name", "L" ++ show l )]
paraTableStyles :: String -> Int -> [Alignment] -> [(String, Doc)]
paraTableStyles :: String -> Int -> [Alignment] -> [(String, Doc Text)]
paraTableStyles _ _ [] = []
paraTableStyles t s (a:xs)
| AlignRight <- a = ( pName s, res s "end" ) : paraTableStyles t (s + 1) xs

69
src/Text/Pandoc/Writers/Org.hs
View file

@ -25,7 +25,7 @@ import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@ -53,31 +53,29 @@ pandocToOrg (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON opts
(fmap render' . blockListToOrg)
(fmap render' . inlineListToOrg)
metadata <- metaToContext opts
blockListToOrg
(fmap chomp . inlineListToOrg)
meta
body <- blockListToOrg blocks
notes <- gets (reverse . stNotes) >>= notesToOrg
hasMath <- gets stHasMath
let main = render colwidth . foldl ($+$) empty $ [body, notes]
let main = body $+$ notes
let context = defField "body" main
. defField "math" hasMath
$ metadata
return $
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Return Org representation of notes.
notesToOrg :: PandocMonad m => [[Block]] -> Org m Doc
notesToOrg :: PandocMonad m => [[Block]] -> Org m (Doc Text)
notesToOrg notes =
vsep <$> zipWithM noteToOrg [1..] notes
-- | Return Org representation of a note.
noteToOrg :: PandocMonad m => Int -> [Block] -> Org m Doc
noteToOrg :: PandocMonad m => Int -> [Block] -> Org m (Doc Text)
noteToOrg num note = do
contents <- blockListToOrg note
let marker = "[fn:" ++ show num ++ "] "
@ -99,7 +97,7 @@ isRawFormat f =
-- | Convert Pandoc block element to Org.
blockToOrg :: PandocMonad m
=> Block -- ^ Block element
-> Org m Doc
-> Org m (Doc Text)
blockToOrg Null = return empty
blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do
contents <- blockListToOrg bs
@ -198,10 +196,9 @@ blockToOrg (Table caption' _ _ headers rows) = do
map ((+2) . numChars) $ transpose (headers' : rawRows)
-- FIXME: Org doesn't allow blocks with height more than 1.
let hpipeBlocks blocks = hcat [beg, middle, end]
where h = maximum (1 : map height blocks)
sep' = lblock 3 $ vcat (replicate h (text " | "))
beg = lblock 2 $ vcat (replicate h (text "| "))
end = lblock 2 $ vcat (replicate h (text " |"))
where sep' = vfill " | "
beg = vfill "| "
end = vfill " |"
middle = hcat $ intersperse sep' blocks
let makeRow = hpipeBlocks . zipWith lblock widthsInChars
let head' = makeRow headers'
@ -219,7 +216,9 @@ blockToOrg (Table caption' _ _ headers rows) = do
blockToOrg (BulletList items) = do
contents <- mapM bulletListItemToOrg items
-- ensure that sublists have preceding blank line
return $ blankline $+$ vcat contents $$ blankline
return $ blankline $$
(if isTightList items then vcat else vsep) contents $$
blankline
blockToOrg (OrderedList (start, _, delim) items) = do
let delim' = case delim of
TwoParens -> OneParen
@ -231,36 +230,48 @@ blockToOrg (OrderedList (start, _, delim) items) = do
in m ++ replicate s ' ') markers
contents <- zipWithM orderedListItemToOrg markers' items
-- ensure that sublists have preceding blank line
return $ blankline $$ vcat contents $$ blankline
return $ blankline $$
(if isTightList items then vcat else vsep) contents $$
blankline
blockToOrg (DefinitionList items) = do
contents <- mapM definitionListItemToOrg items
return $ vcat contents $$ blankline
-- | Convert bullet list item (list of blocks) to Org.
bulletListItemToOrg :: PandocMonad m => [Block] -> Org m Doc
bulletListItemToOrg :: PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg items = do
contents <- blockListToOrg items
return $ hang 2 "- " (contents <> cr)
return $ hang 2 "- " contents $$
if endsWithPlain items
then cr
else blankline
-- | Convert ordered list item (a list of blocks) to Org.
orderedListItemToOrg :: PandocMonad m
=> String -- ^ marker for list item
-> [Block] -- ^ list item (list of blocks)
-> Org m Doc
-> Org m (Doc Text)
orderedListItemToOrg marker items = do
contents <- blockListToOrg items
return $ hang (length marker + 1) (text marker <> space) (contents <> cr)
return $ hang (length marker + 1) (text marker <> space) contents $$
if endsWithPlain items
then cr
else blankline
-- | Convert definition list item (label, list of blocks) to Org.
definitionListItemToOrg :: PandocMonad m
=> ([Inline], [[Block]]) -> Org m Doc
=> ([Inline], [[Block]]) -> Org m (Doc Text)
definitionListItemToOrg (label, defs) = do
label' <- inlineListToOrg label
contents <- vcat <$> mapM blockListToOrg defs
return . hang 2 "- " $ label' <> " :: " <> (contents <> cr)
return $ hang 2 "- " (label' <> " :: " <> contents) $$
if isTightList defs
then cr
else blankline
-- | Convert list of key/value pairs to Org :PROPERTIES: drawer.
propertiesDrawer :: Attr -> Doc
propertiesDrawer :: Attr -> Doc Text
propertiesDrawer (ident, classes, kv) =
let
drawerStart = text ":PROPERTIES:"
@ -271,11 +282,11 @@ propertiesDrawer (ident, classes, kv) =
in
drawerStart <> cr <> properties <> cr <> drawerEnd
where
kvToOrgProperty :: (String, String) -> Doc
kvToOrgProperty :: (String, String) -> Doc Text
kvToOrgProperty (key, value) =
text ":" <> text key <> text ": " <> text value <> cr
attrHtml :: Attr -> Doc
attrHtml :: Attr -> Doc Text
attrHtml ("" , [] , []) = mempty
attrHtml (ident, classes, kvs) =
let
@ -288,13 +299,13 @@ attrHtml (ident, classes, kvs) =
-- | Convert list of Pandoc block elements to Org.
blockListToOrg :: PandocMonad m
=> [Block] -- ^ List of block elements
-> Org m Doc
-> Org m (Doc Text)
blockListToOrg blocks = vcat <$> mapM blockToOrg blocks
-- | Convert list of Pandoc inline elements to Org.
inlineListToOrg :: PandocMonad m
=> [Inline]
-> Org m Doc
-> Org m (Doc Text)
inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixMarkers lst)
where fixMarkers [] = [] -- prevent note refs and list markers from wrapping, see #4171
fixMarkers (Space : x : rest) | shouldFix x =
@ -309,7 +320,7 @@ inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixMarkers lst)
shouldFix _ = False
-- | Convert Pandoc inline element to Org.
inlineToOrg :: PandocMonad m => Inline -> Org m Doc
inlineToOrg :: PandocMonad m => Inline -> Org m (Doc Text)
inlineToOrg (Span (uid, [], []) []) =
return $ "<<" <> text uid <> ">>"
inlineToOrg (Span _ lst) =

96
src/Text/Pandoc/Writers/RST.hs
View file

@ -17,16 +17,17 @@ module Text.Pandoc.Writers.RST ( writeRST, flatten ) where
import Prelude
import Control.Monad.State.Strict
import Data.Char (isSpace, toLower)
import Data.List (isPrefixOf, stripPrefix, transpose)
import Data.List (isPrefixOf, stripPrefix, transpose, intersperse)
import Data.Maybe (fromMaybe)
import Data.Text (Text, stripEnd)
import qualified Data.Text as T
import Data.Text (Text)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@ -62,13 +63,11 @@ pandocToRST (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
let subtit = lookupMetaInlines "subtitle" meta
title <- titleToRST (docTitle meta) subtit
metadata <- metaToJSON opts
(fmap render' . blockListToRST)
(fmap (stripEnd . render') . inlineListToRST)
metadata <- metaToContext opts
blockListToRST
(fmap chomp . inlineListToRST)
meta
body <- blockListToRST' True $ case writerTemplate opts of
Just _ -> normalizeHeadings 1 blocks
@ -79,16 +78,16 @@ pandocToRST (Pandoc meta blocks) = do
pics <- gets (reverse . stImages) >>= pictRefsToRST
hasMath <- gets stHasMath
rawTeX <- gets stHasRawTeX
let main = render' $ foldl ($+$) empty [body, notes, refs, pics]
let main = vsep [body, notes, refs, pics]
let context = defField "body" main
$ defField "toc" (writerTableOfContents opts)
$ defField "toc-depth" (show $ writerTOCDepth opts)
$ defField "toc-depth" (T.pack $ show $ writerTOCDepth opts)
$ defField "number-sections" (writerNumberSections opts)
$ defField "math" hasMath
$ defField "titleblock" (render Nothing title :: String)
$ defField "titleblock" (render Nothing title :: Text)
$ defField "math" hasMath
$ defField "rawtex" rawTeX metadata
return $
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
@ -102,26 +101,26 @@ pandocToRST (Pandoc meta blocks) = do
normalizeHeadings _ [] = []
-- | Return RST representation of reference key table.
refsToRST :: PandocMonad m => Refs -> RST m Doc
refsToRST :: PandocMonad m => Refs -> RST m (Doc Text)
refsToRST refs = mapM keyToRST refs >>= return . vcat
-- | Return RST representation of a reference key.
keyToRST :: PandocMonad m => ([Inline], (String, String)) -> RST m Doc
keyToRST :: PandocMonad m => ([Inline], (String, String)) -> RST m (Doc Text)
keyToRST (label, (src, _)) = do
label' <- inlineListToRST label
let label'' = if ':' `elem` (render Nothing label' :: String)
let label'' = if (==':') `T.any` (render Nothing label' :: Text)
then char '`' <> label' <> char '`'
else label'
return $ nowrap $ ".. _" <> label'' <> ": " <> text src
-- | Return RST representation of notes.
notesToRST :: PandocMonad m => [[Block]] -> RST m Doc
notesToRST :: PandocMonad m => [[Block]] -> RST m (Doc Text)
notesToRST notes =
zipWithM noteToRST [1..] notes >>=
return . vsep
-- | Return RST representation of a note.
noteToRST :: PandocMonad m => Int -> [Block] -> RST m Doc
noteToRST :: PandocMonad m => Int -> [Block] -> RST m (Doc Text)
noteToRST num note = do
contents <- blockListToRST note
let marker = ".. [" <> text (show num) <> "]"
@ -130,13 +129,13 @@ noteToRST num note = do
-- | Return RST representation of picture reference table.
pictRefsToRST :: PandocMonad m
=> [([Inline], (Attr, String, String, Maybe String))]
-> RST m Doc
-> RST m (Doc Text)
pictRefsToRST refs = mapM pictToRST refs >>= return . vcat
-- | Return RST representation of a picture substitution reference.
pictToRST :: PandocMonad m
=> ([Inline], (Attr, String, String, Maybe String))
-> RST m Doc
-> RST m (Doc Text)
pictToRST (label, (attr, src, _, mbtarget)) = do
label' <- inlineListToRST label
dims <- imageDimsToRST attr
@ -171,14 +170,14 @@ escapeString = escapeString' True
_ -> '.':escapeString' False opts cs
_ -> c : escapeString' False opts cs
titleToRST :: PandocMonad m => [Inline] -> [Inline] -> RST m Doc
titleToRST :: PandocMonad m => [Inline] -> [Inline] -> RST m (Doc Text)
titleToRST [] _ = return empty
titleToRST tit subtit = do
title <- inlineListToRST tit
subtitle <- inlineListToRST subtit
return $ bordered title '=' $$ bordered subtitle '-'
bordered :: Doc -> Char -> Doc
bordered :: Doc Text -> Char -> Doc Text
bordered contents c =
if len > 0
then border $$ contents $$ border
@ -189,7 +188,7 @@ bordered contents c =
-- | Convert Pandoc block element to RST.
blockToRST :: PandocMonad m
=> Block -- ^ Block element
-> RST m Doc
-> RST m (Doc Text)
blockToRST Null = return empty
blockToRST (Div ("",["admonition-title"],[]) _) = return empty
-- this is generated by the rst reader and can safely be
@ -301,7 +300,9 @@ blockToRST (Table caption aligns widths headers rows) = do
blockToRST (BulletList items) = do
contents <- mapM bulletListItemToRST items
-- ensure that sublists have preceding blank line
return $ blankline $$ chomp (vcat contents) $$ blankline
return $ blankline $$
(if isTightList items then vcat else vsep) contents $$
blankline
blockToRST (OrderedList (start, style', delim) items) = do
let markers = if start == 1 && style' == DefaultStyle && delim == DefaultDelim
then replicate (length items) "#."
@ -312,37 +313,48 @@ blockToRST (OrderedList (start, style', delim) items) = do
in m ++ replicate s ' ') markers
contents <- zipWithM orderedListItemToRST markers' items
-- ensure that sublists have preceding blank line
return $ blankline $$ chomp (vcat contents) $$ blankline
return $ blankline $$
(if isTightList items then vcat else vsep) contents $$
blankline
blockToRST (DefinitionList items) = do
contents <- mapM definitionListItemToRST items
-- ensure that sublists have preceding blank line
return $ blankline $$ chomp (vcat contents) $$ blankline
return $ blankline $$ vcat contents $$ blankline
-- | Convert bullet list item (list of blocks) to RST.
bulletListItemToRST :: PandocMonad m => [Block] -> RST m Doc
bulletListItemToRST :: PandocMonad m => [Block] -> RST m (Doc Text)
bulletListItemToRST items = do
contents <- blockListToRST items
return $ hang 3 "- " $ contents <> cr
return $ hang 3 "- " contents $$
if endsWithPlain items
then cr
else blankline
-- | Convert ordered list item (a list of blocks) to RST.
orderedListItemToRST :: PandocMonad m
=> String -- ^ marker for list item
-> [Block] -- ^ list item (list of blocks)
-> RST m Doc
-> RST m (Doc Text)
orderedListItemToRST marker items = do
contents <- blockListToRST items
let marker' = marker ++ " "
return $ hang (length marker') (text marker') $ contents <> cr
return $ hang (length marker') (text marker') contents $$
if endsWithPlain items
then cr
else blankline
-- | Convert definition list item (label, list of blocks) to RST.
definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m Doc
definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m (Doc Text)
definitionListItemToRST (label, defs) = do
label' <- inlineListToRST label
contents <- liftM vcat $ mapM blockListToRST defs
return $ nowrap label' $$ nest 3 (nestle contents <> cr)
return $ nowrap label' $$ nest 3 (nestle contents) $$
if isTightList defs
then cr
else blankline
-- | Format a list of lines as line block.
linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m Doc
linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m (Doc Text)
linesToLineBlock inlineLines = do
lns <- mapM inlineListToRST inlineLines
return $
@ -352,7 +364,7 @@ linesToLineBlock inlineLines = do
blockListToRST' :: PandocMonad m
=> Bool
-> [Block] -- ^ List of block elements
-> RST m Doc
-> RST m (Doc Text)
blockListToRST' topLevel blocks = do
-- insert comment between list and quoted blocks, see #4248 and #3675
let fixBlocks (b1:b2@(BlockQuote _):bs)
@ -376,7 +388,7 @@ blockListToRST' topLevel blocks = do
blockListToRST :: PandocMonad m
=> [Block] -- ^ List of block elements
-> RST m Doc
-> RST m (Doc Text)
blockListToRST = blockListToRST' False
transformInlines :: [Inline] -> [Inline]
@ -532,15 +544,15 @@ setInlineChildren (Image a _ t) i = Image a i t
setInlineChildren (Span a _) i = Span a i
setInlineChildren leaf _ = leaf
inlineListToRST :: PandocMonad m => [Inline] -> RST m Doc
inlineListToRST :: PandocMonad m => [Inline] -> RST m (Doc Text)
inlineListToRST = writeInlines . walk transformInlines
-- | Convert list of Pandoc inline elements to RST.
writeInlines :: PandocMonad m => [Inline] -> RST m Doc
writeInlines :: PandocMonad m => [Inline] -> RST m (Doc Text)
writeInlines lst = mapM inlineToRST lst >>= return . hcat
-- | Convert Pandoc inline element to RST.
inlineToRST :: PandocMonad m => Inline -> RST m Doc
inlineToRST :: PandocMonad m => Inline -> RST m (Doc Text)
inlineToRST (Span (_,_,kvs) ils) = do
contents <- writeInlines ils
return $
@ -653,7 +665,7 @@ inlineToRST (Note contents) = do
let ref = show $ length notes + 1
return $ " [" <> text ref <> "]_"
registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe String -> RST m Doc
registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe String -> RST m (Doc Text)
registerImage attr alt (src,tit) mbtarget = do
pics <- gets stImages
txt <- case lookup alt pics of
@ -668,7 +680,7 @@ registerImage attr alt (src,tit) mbtarget = do
return alt'
inlineListToRST txt
imageDimsToRST :: PandocMonad m => Attr -> RST m Doc
imageDimsToRST :: PandocMonad m => Attr -> RST m (Doc Text)
imageDimsToRST attr = do
let (ident, _, _) = attr
name = if null ident
@ -686,10 +698,10 @@ imageDimsToRST attr = do
simpleTable :: PandocMonad m
=> WriterOptions
-> (WriterOptions -> [Block] -> m Doc)
-> (WriterOptions -> [Block] -> m (Doc Text))
-> [[Block]]
-> [[[Block]]]
-> m Doc
-> m (Doc Text)
simpleTable opts blocksToDoc headers rows = do
-- can't have empty cells in first column:
let fixEmpties (d:ds) = if isEmpty d
@ -703,7 +715,7 @@ simpleTable opts blocksToDoc headers rows = do
let numChars [] = 0
numChars xs = maximum . map offset $ xs
let colWidths = map numChars $ transpose (headerDocs : rowDocs)
let toRow = hsep . zipWith lblock colWidths
let toRow = mconcat . intersperse (lblock 1 " ") . zipWith lblock colWidths
let hline = nowrap $ hsep (map (\n -> text (replicate n '=')) colWidths)
let hdr = if all null headers
then mempty

7
src/Text/Pandoc/Writers/RTF.hs
View file

@ -96,7 +96,7 @@ writeRTF options doc = do
. M.adjust toPlain "author"
. M.adjust toPlain "date"
$ metamap
metadata <- metaToJSON options
metadata <- metaToContext options
(fmap concat . mapM (blockToRTF 0 AlignDefault))
inlinesToRTF
meta'
@ -112,11 +112,10 @@ writeRTF options doc = do
-- of the toc rather than a boolean:
. defField "toc" toc
else id) metadata
return $
return $ T.pack $
case writerTemplate options of
Just tpl -> renderTemplate tpl context
Nothing -> T.pack $
case reverse body of
Nothing -> case reverse body of
('\n':_) -> body
_ -> body ++ "\n"

8
src/Text/Pandoc/Writers/Roff.hs
View file

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

209
src/Text/Pandoc/Writers/Shared.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
@ -13,9 +14,9 @@
Shared utility functions for pandoc writers.
-}
module Text.Pandoc.Writers.Shared (
metaToJSON
, metaToJSON'
, addVariablesToJSON
metaToContext
, metaToContext'
, addVariablesToContext
, getField
, setField
, resetField
@ -33,149 +34,118 @@ module Text.Pandoc.Writers.Shared (
, toSubscript
, toSuperscript
, toTableOfContents
, endsWithPlain
)
where
import Prelude
import Safe (lastMay)
import Control.Monad (zipWithM)
import qualified Data.Aeson as Aeson
import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
encode, fromJSON)
import Data.Aeson (ToJSON (..), encode)
import Data.Char (chr, ord, isSpace)
import qualified Data.HashMap.Strict as H
import Data.List (groupBy, intersperse, transpose, foldl')
import Data.Scientific (Scientific)
import qualified Data.Map as M
import Data.Maybe (isJust)
import qualified Data.Text as T
import qualified Data.Traversable as Traversable
import qualified Text.Pandoc.Builder as Builder
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.Pandoc.Shared (stringify, hierarchicalize, Element(..), deNote,
safeRead)
import Text.DocLayout
import Text.Pandoc.Shared (stringify, hierarchicalize, Element(..), deNote)
import Text.Pandoc.Walk (walk)
import Text.Pandoc.UTF8 (toStringLazy)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.XML (escapeStringForXML)
import Text.DocTemplates (Context(..), Val(..), TemplateTarget(..),
ToContext(..), FromContext(..))
-- | Create JSON value for template from a 'Meta' and an association list
-- | Create template Context from a 'Meta' and an association list
-- of variables, specified at the command line or in the writer.
-- Variables overwrite metadata fields with the same names.
-- If multiple variables are set with the same name, a list is
-- assigned. Does nothing if 'writerTemplate' is Nothing.
metaToJSON :: (Monad m, ToJSON a)
=> WriterOptions
-> ([Block] -> m a)
-> ([Inline] -> m a)
-> Meta
-> m Value
metaToJSON opts blockWriter inlineWriter meta
| isJust (writerTemplate opts) =
addVariablesToJSON opts <$> metaToJSON' blockWriter inlineWriter meta
| otherwise = return (Object H.empty)
metaToContext :: (Monad m, TemplateTarget a)
=> WriterOptions
-> ([Block] -> m a)
-> ([Inline] -> m a)
-> Meta
-> m (Context a)
metaToContext opts blockWriter inlineWriter meta =
case writerTemplate opts of
Nothing -> return mempty
Just _ -> addVariablesToContext opts <$>
metaToContext' blockWriter inlineWriter meta
-- | Like 'metaToJSON', but does not include variables and is
-- | Like 'metaToContext, but does not include variables and is
-- not sensitive to 'writerTemplate'.
metaToJSON' :: (Monad m, ToJSON a)
metaToContext' :: (Monad m, TemplateTarget a)
=> ([Block] -> m a)
-> ([Inline] -> m a)
-> Meta
-> m Value
metaToJSON' blockWriter inlineWriter (Meta metamap) = do
renderedMap <- Traversable.mapM
(metaValueToJSON blockWriter inlineWriter)
metamap
return $ M.foldrWithKey defField (Object H.empty) renderedMap
-> m (Context a)
metaToContext' blockWriter inlineWriter (Meta metamap) = do
renderedMap <- mapM (metaValueToVal blockWriter inlineWriter) metamap
return $ Context
$ M.foldrWithKey (\k v x -> M.insert (T.pack k) v x) mempty
$ renderedMap
-- | Add variables to JSON object, replacing any existing values.
-- Also include @meta-json@, a field containing a string representation
-- of the original JSON object itself, prior to addition of variables.
addVariablesToJSON :: WriterOptions -> Value -> Value
addVariablesToJSON opts metadata =
foldl (\acc (x,y) -> setField x y acc)
(defField "meta-json" (toStringLazy $ encode metadata) (Object mempty))
(writerVariables opts)
`combineMetadata` metadata
where combineMetadata (Object o1) (Object o2) = Object $ H.union o1 o2
combineMetadata x _ = x
-- | Add variables to a template Context, replacing any existing values.
addVariablesToContext :: TemplateTarget a
=> WriterOptions -> Context a -> Context a
addVariablesToContext opts (Context m1) = Context (m1 `M.union` m2)
where
m2 = M.fromList $ map (\(k,v)
-> (T.pack k,SimpleVal (fromText (T.pack v)))) $
("meta-json", jsonrep) : writerVariables opts
jsonrep = UTF8.toStringLazy $ encode $ toJSON m1
metaValueToJSON :: (Monad m, ToJSON a)
=> ([Block] -> m a)
-> ([Inline] -> m a)
-> MetaValue
-> m Value
metaValueToJSON blockWriter inlineWriter (MetaMap metamap) = toJSON <$>
Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap
metaValueToJSON blockWriter inlineWriter (MetaList xs) = toJSON <$>
Traversable.mapM (metaValueToJSON blockWriter inlineWriter) xs
metaValueToJSON _ _ (MetaBool b) = return $ toJSON b
metaValueToJSON _ inlineWriter (MetaString s@('0':_:_)) =
-- don't treat string with leading 0 as string (#5479)
toJSON <$> inlineWriter (Builder.toList (Builder.text s))
metaValueToJSON _ inlineWriter (MetaString s) =
case safeRead s of
Just (n :: Scientific) -> return $ Aeson.Number n
Nothing -> toJSON <$> inlineWriter (Builder.toList (Builder.text s))
metaValueToJSON blockWriter _ (MetaBlocks bs) = toJSON <$> blockWriter bs
metaValueToJSON blockWriter inlineWriter (MetaInlines [Str s]) =
metaValueToJSON blockWriter inlineWriter (MetaString s)
metaValueToJSON _ inlineWriter (MetaInlines is) = toJSON <$> inlineWriter is
metaValueToVal :: (Monad m, TemplateTarget a)
=> ([Block] -> m a)
-> ([Inline] -> m a)
-> MetaValue
-> m (Val a)
metaValueToVal blockWriter inlineWriter (MetaMap metamap) =
MapVal . Context . M.mapKeys T.pack <$>
mapM (metaValueToVal blockWriter inlineWriter) metamap
metaValueToVal blockWriter inlineWriter (MetaList xs) = ListVal <$>
mapM (metaValueToVal blockWriter inlineWriter) xs
metaValueToVal _ _ (MetaBool True) = return $ SimpleVal $ fromText "true"
metaValueToVal _ _ (MetaBool False) = return NullVal
metaValueToVal _ inlineWriter (MetaString s) =
SimpleVal <$> inlineWriter (Builder.toList (Builder.text s))
metaValueToVal blockWriter _ (MetaBlocks bs) = SimpleVal <$> blockWriter bs
metaValueToVal _ inlineWriter (MetaInlines is) = SimpleVal <$> inlineWriter is
-- | 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
=> String
-> a
-> Value
-> Value
-- | Set a field of a JSON object. If the field already has a value,
-- | Retrieve a field value from a template context.
getField :: FromContext a b => String -> Context a -> Maybe b
getField field (Context m) = M.lookup (T.pack field) m >>= fromVal
-- | Set a field of a template context. If the field already has a value,
-- convert it into a list with the new value appended to the old value(s).
-- This is a utility function to be used in preparing template contexts.
setField field val (Object hashmap) =
Object $ H.insertWith combine (T.pack field) (toJSON val) hashmap
where combine newval oldval =
case fromJSON oldval of
Success xs -> toJSON $ xs ++ [newval]
_ -> toJSON [oldval, newval]
setField _ _ x = x
setField :: ToContext a b => String -> b -> Context a -> Context a
setField field val (Context m) =
Context $ M.insertWith combine (T.pack field) (toVal val) m
where
combine newval (ListVal xs) = ListVal (xs ++ [newval])
combine newval x = ListVal [x, newval]
resetField :: ToJSON a
=> String
-> a
-> Value
-> Value
-- | Reset a field of a JSON object. If the field already has a value,
-- the new value replaces it.
-- | Reset a field of a template context. If the field already has a
-- value, the new value replaces it.
-- This is a utility function to be used in preparing template contexts.
resetField field val (Object hashmap) =
Object $ H.insert (T.pack field) (toJSON val) hashmap
resetField _ _ x = x
resetField :: ToContext a b => String -> b -> Context a -> Context a
resetField field val (Context m) =
Context (M.insert (T.pack field) (toVal val) m)
defField :: ToJSON a
=> String
-> a
-> Value
-> Value
-- | Set a field of a JSON object if it currently has no value.
-- | Set a field of a template context if it currently has no value.
-- If it has a value, do nothing.
-- This is a utility function to be used in preparing template contexts.
defField field val (Object hashmap) =
Object $ H.insertWith f (T.pack field) (toJSON val) hashmap
where f _newval oldval = oldval
defField _ _ x = x
defField :: ToContext a b => String -> b -> Context a -> Context a
defField field val (Context m) =
Context (M.insertWith f (T.pack field) (toVal val) m)
where
f _newval oldval = oldval
-- Produce an HTML tag with the given pandoc attributes.
tagWithAttrs :: String -> Attr -> Doc
tagWithAttrs :: HasChars a => String -> Attr -> Doc a
tagWithAttrs tag (ident,classes,kvs) = hsep
["<" <> text tag
,if null ident
@ -236,15 +206,15 @@ unsmartify opts ('\8216':xs) = '\'' : unsmartify opts xs
unsmartify opts (x:xs) = x : unsmartify opts xs
unsmartify _ [] = []
gridTable :: Monad m
gridTable :: (Monad m, HasChars a)
=> WriterOptions
-> (WriterOptions -> [Block] -> m Doc)
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool -- ^ headless
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> m Doc
-> m (Doc a)
gridTable opts blocksToDoc headless aligns widths headers rows = do
-- the number of columns will be used in case of even widths
let numcols = maximum (length aligns : length widths :
@ -299,10 +269,9 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do
| otherwise = handleGivenWidths widths
(widthsInChars, rawHeaders, rawRows) <- handleWidths
let hpipeBlocks blocks = hcat [beg, middle, end]
where h = maximum (1 : map height blocks)
sep' = lblock 3 $ vcat (replicate h (text " | "))
beg = lblock 2 $ vcat (replicate h (text "| "))
end = lblock 2 $ vcat (replicate h (text " |"))
where sep' = vfill " | "
beg = vfill "| "
end = vfill " |"
middle = chomp $ hcat $ intersperse sep' blocks
let makeRow = hpipeBlocks . zipWith lblock widthsInChars
let head' = makeRow rawHeaders
@ -427,3 +396,9 @@ elementToListItem opts (Sec lev _nums (ident,_,_) headerText subsecs)
else [Link nullAttr headerText' ('#':ident, "")]
listContents = map (elementToListItem opts) subsecs
elementToListItem _ (Blk _) = []
endsWithPlain :: [Block] -> Bool
endsWithPlain xs =
case lastMay xs of
Just (Plain{}) -> True
_ -> False

43
src/Text/Pandoc/Writers/TEI.hs
View file

@ -23,7 +23,7 @@ import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@ -36,31 +36,28 @@ writeTEI opts (Pandoc meta blocks) = do
colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
render' :: Doc -> Text
render' = render colwidth
startLvl = case writerTopLevelDivision opts of
TopLevelPart -> -1
TopLevelChapter -> 0
TopLevelSection -> 1
TopLevelDefault -> 1
metadata <- metaToJSON opts
(fmap (render' . vcat) .
metadata <- metaToContext opts
(fmap vcat .
mapM (elementToTEI opts startLvl) . hierarchicalize)
(fmap render' . inlinesToTEI opts)
(fmap chomp . inlinesToTEI opts)
meta
main <- (render' . vcat) <$> mapM (elementToTEI opts startLvl) elements
main <- vcat <$> mapM (elementToTEI opts startLvl) elements
let context = defField "body" main
$
defField "mathml" (case writerHTMLMathMethod opts of
$ defField "mathml" (case writerHTMLMathMethod opts of
MathML -> True
_ -> False) metadata
return $
return $ render colwidth $
case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate tpl context
-- | Convert an Element to TEI.
elementToTEI :: PandocMonad m => WriterOptions -> Int -> Element -> m Doc
elementToTEI :: PandocMonad m => WriterOptions -> Int -> Element -> m (Doc Text)
elementToTEI opts _ (Blk block) = blockToTEI opts block
elementToTEI opts lvl (Sec _ _num attr title elements) = do
-- TEI doesn't allow sections with no content, so insert some if needed
@ -79,7 +76,7 @@ elementToTEI opts lvl (Sec _ _num attr title elements) = do
inTagsSimple "head" titleContents $$ contents
-- | Convert a list of Pandoc blocks to TEI.
blocksToTEI :: PandocMonad m => WriterOptions -> [Block] -> m Doc
blocksToTEI :: PandocMonad m => WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI opts bs = vcat <$> mapM (blockToTEI opts) bs
-- | Auxiliary function to convert Plain block to Para.
@ -90,13 +87,13 @@ plainToPara x = x
-- | Convert a list of pairs of terms and definitions into a TEI
-- list with labels and items.
deflistItemsToTEI :: PandocMonad m
=> WriterOptions -> [([Inline],[[Block]])] -> m Doc
=> WriterOptions -> [([Inline],[[Block]])] -> m (Doc Text)
deflistItemsToTEI opts items =
vcat <$> mapM (uncurry (deflistItemToTEI opts)) items
-- | Convert a term and a list of blocks into a TEI varlistentry.
deflistItemToTEI :: PandocMonad m
=> WriterOptions -> [Inline] -> [[Block]] -> m Doc
=> WriterOptions -> [Inline] -> [[Block]] -> m (Doc Text)
deflistItemToTEI opts term defs = do
term' <- inlinesToTEI opts term
defs' <- blocksToTEI opts $ concatMap (map plainToPara) defs
@ -104,15 +101,15 @@ deflistItemToTEI opts term defs = do
inTagsIndented "item" defs'
-- | Convert a list of lists of blocks to a list of TEI list items.
listItemsToTEI :: PandocMonad m => WriterOptions -> [[Block]] -> m Doc
listItemsToTEI :: PandocMonad m => WriterOptions -> [[Block]] -> m (Doc Text)
listItemsToTEI opts items = vcat <$> mapM (listItemToTEI opts) items
-- | Convert a list of blocks into a TEI list item.
listItemToTEI :: PandocMonad m => WriterOptions -> [Block] -> m Doc
listItemToTEI :: PandocMonad m => WriterOptions -> [Block] -> m (Doc Text)
listItemToTEI opts item =
inTagsIndented "item" <$> blocksToTEI opts (map plainToPara item)
imageToTEI :: PandocMonad m => WriterOptions -> Attr -> String -> m Doc
imageToTEI :: PandocMonad m => WriterOptions -> Attr -> String -> m (Doc Text)
imageToTEI opts attr src = return $ selfClosingTag "graphic" $
("url", src) : idFromAttr opts attr ++ dims
where
@ -122,7 +119,7 @@ imageToTEI opts attr src = return $ selfClosingTag "graphic" $
Nothing -> []
-- | Convert a Pandoc block element to TEI.
blockToTEI :: PandocMonad m => WriterOptions -> Block -> m Doc
blockToTEI :: PandocMonad m => WriterOptions -> Block -> m (Doc Text)
blockToTEI _ Null = return empty
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
@ -212,14 +209,14 @@ blockToTEI opts (Table _ _ _ headers rows) = do
tableRowToTEI :: PandocMonad m
=> WriterOptions
-> [[Block]]
-> m Doc
-> m (Doc Text)
tableRowToTEI opts cols =
(inTagsIndented "row" . vcat) <$> mapM (tableItemToTEI opts) cols
tableHeadersToTEI :: PandocMonad m
=> WriterOptions
-> [[Block]]
-> m Doc
-> m (Doc Text)
tableHeadersToTEI opts cols =
(inTags True "row" [("role","label")] . vcat) <$>
mapM (tableItemToTEI opts) cols
@ -227,16 +224,16 @@ tableHeadersToTEI opts cols =
tableItemToTEI :: PandocMonad m
=> WriterOptions
-> [Block]
-> m Doc
-> m (Doc Text)
tableItemToTEI opts item =
(inTags False "cell" [] . vcat) <$> mapM (blockToTEI opts) item
-- | Convert a list of inline elements to TEI.
inlinesToTEI :: PandocMonad m => WriterOptions -> [Inline] -> m Doc
inlinesToTEI :: PandocMonad m => WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI opts lst = hcat <$> mapM (inlineToTEI opts) lst
-- | Convert an inline element to TEI.
inlineToTEI :: PandocMonad m => WriterOptions -> Inline -> m Doc
inlineToTEI :: PandocMonad m => WriterOptions -> Inline -> m (Doc Text)
inlineToTEI _ (Str str) = return $ text $ escapeStringForXML str
inlineToTEI opts (Emph lst) =
inTags False "hi" [("rendition","simple:italic")] <$> inlinesToTEI opts lst

49
src/Text/Pandoc/Writers/Texinfo.hs
View file

@ -21,6 +21,7 @@ import Data.List (maximumBy, transpose)
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (unEscapeString)
import System.FilePath
import Text.Pandoc.Class (PandocMonad, report)
@ -29,7 +30,7 @@ import Text.Pandoc.Error
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
@ -68,21 +69,17 @@ pandocToTexinfo options (Pandoc meta blocks) = do
let colwidth = if writerWrapText options == WrapAuto
then Just $ writerColumns options
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON options
(fmap render' . blockListToTexinfo)
(fmap render' . inlineListToTexinfo)
metadata <- metaToContext options
(blockListToTexinfo)
(fmap chomp .inlineListToTexinfo)
meta
main <- blockListToTexinfo blocks
body <- blockListToTexinfo blocks
st <- get
let body = render colwidth main
let context = defField "body" body
$ defField "toc" (writerTableOfContents options)
$ defField "titlepage" titlePage
$
defField "strikeout" (stStrikeout st) metadata
return $
$ defField "strikeout" (stStrikeout st) metadata
return $ render colwidth $
case writerTemplate options of
Nothing -> body
Just tpl -> renderTemplate tpl context
@ -100,7 +97,7 @@ stringToTexinfo = escapeStringUsing texinfoEscapes
, ('\x2019', "'")
]
escapeCommas :: PandocMonad m => TI m Doc -> TI m Doc
escapeCommas :: PandocMonad m => TI m (Doc Text) -> TI m (Doc Text)
escapeCommas parser = do
oldEscapeComma <- gets stEscapeComma
modify $ \st -> st{ stEscapeComma = True }
@ -109,13 +106,13 @@ escapeCommas parser = do
return res
-- | Puts contents into Texinfo command.
inCmd :: String -> Doc -> Doc
inCmd :: String -> Doc Text -> Doc Text
inCmd cmd contents = char '@' <> text cmd <> braces contents
-- | Convert Pandoc block element to Texinfo.
blockToTexinfo :: PandocMonad m
=> Block -- ^ Block to convert
-> TI m Doc
-> TI m (Doc Text)
blockToTexinfo Null = return empty
@ -241,7 +238,7 @@ blockToTexinfo (Table caption aligns widths heads rows) = do
colDescriptors <-
if all (== 0) widths
then do -- use longest entry instead of column widths
cols <- mapM (mapM (liftM (render Nothing . hcat) . mapM blockToTexinfo)) $
cols <- mapM (mapM (liftM (T.unpack . render Nothing . hcat) . mapM blockToTexinfo)) $
transpose $ heads : rows
return $ concatMap ((\x -> "{"++x++"} ") . maximumBy (comparing length)) cols
else return $ "@columnfractions " ++ concatMap (printf "%.2f ") widths
@ -259,20 +256,20 @@ blockToTexinfo (Table caption aligns widths heads rows) = do
tableHeadToTexinfo :: PandocMonad m
=> [Alignment]
-> [[Block]]
-> TI m Doc
-> TI m (Doc Text)
tableHeadToTexinfo = tableAnyRowToTexinfo "@headitem "
tableRowToTexinfo :: PandocMonad m
=> [Alignment]
-> [[Block]]
-> TI m Doc
-> TI m (Doc Text)
tableRowToTexinfo = tableAnyRowToTexinfo "@item "
tableAnyRowToTexinfo :: PandocMonad m
=> String
-> [Alignment]
-> [[Block]]
-> TI m Doc
-> TI m (Doc Text)
tableAnyRowToTexinfo itemtype aligns cols =
zipWithM alignedBlock aligns cols >>=
return . (text itemtype $$) . foldl (\row item -> row $$
@ -281,7 +278,7 @@ tableAnyRowToTexinfo itemtype aligns cols =
alignedBlock :: PandocMonad m
=> Alignment
-> [Block]
-> TI m Doc
-> TI m (Doc Text)
-- XXX @flushleft and @flushright text won't get word wrapped. Since word
-- wrapping is more important than alignment, we ignore the alignment.
alignedBlock _ = blockListToTexinfo
@ -298,7 +295,7 @@ alignedBlock _ col = blockListToTexinfo col
-- | Convert Pandoc block elements to Texinfo.
blockListToTexinfo :: PandocMonad m
=> [Block]
-> TI m Doc
-> TI m (Doc Text)
blockListToTexinfo [] = return empty
blockListToTexinfo (x:xs) = do
x' <- blockToTexinfo x
@ -340,7 +337,7 @@ collectNodes level (x:xs) =
makeMenuLine :: PandocMonad m
=> Block
-> TI m Doc
-> TI m (Doc Text)
makeMenuLine (Header _ _ lst) = do
txt <- inlineListForNode lst
return $ text "* " <> txt <> text "::"
@ -348,7 +345,7 @@ makeMenuLine _ = throwError $ PandocSomeError "makeMenuLine called with non-Head
listItemToTexinfo :: PandocMonad m
=> [Block]
-> TI m Doc
-> TI m (Doc Text)
listItemToTexinfo lst = do
contents <- blockListToTexinfo lst
let spacer = case reverse lst of
@ -358,7 +355,7 @@ listItemToTexinfo lst = do
defListItemToTexinfo :: PandocMonad m
=> ([Inline], [[Block]])
-> TI m Doc
-> TI m (Doc Text)
defListItemToTexinfo (term, defs) = do
term' <- inlineListToTexinfo term
let defToTexinfo bs = do d <- blockListToTexinfo bs
@ -371,13 +368,13 @@ defListItemToTexinfo (term, defs) = do
-- | Convert list of inline elements to Texinfo.
inlineListToTexinfo :: PandocMonad m
=> [Inline] -- ^ Inlines to convert
-> TI m Doc
-> TI m (Doc Text)
inlineListToTexinfo lst = hcat <$> mapM inlineToTexinfo lst
-- | Convert list of inline elements to Texinfo acceptable for a node name.
inlineListForNode :: PandocMonad m
=> [Inline] -- ^ Inlines to convert
-> TI m Doc
-> TI m (Doc Text)
inlineListForNode = return . text . stringToTexinfo .
filter (not . disallowedInNode) . stringify
@ -388,7 +385,7 @@ disallowedInNode c = c `elem` (".,:()" :: String)
-- | Convert inline element to Texinfo
inlineToTexinfo :: PandocMonad m
=> Inline -- ^ Inline to convert
-> TI m Doc
-> TI m (Doc Text)
inlineToTexinfo (Span _ lst) =
inlineListToTexinfo lst

8
src/Text/Pandoc/Writers/Textile.hs
View file

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

11
src/Text/Pandoc/Writers/ZimWiki.hs
View file

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

14
src/Text/Pandoc/XML.hs
View file

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

3
stack.yaml
View file

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

1
test/command/3531.md
View file

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

1
test/command/3824.md
View file

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

1
test/command/4794.md
View file

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

2
test/command/5107.md
View file

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

1
test/tables.custom
View file

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

1
test/tables.dokuwiki
View file

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

1
test/tables.fb2
View file

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

1
test/tables.jira
View file

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

1
test/tables.mediawiki
View file

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

1
test/tables.rtf
View file

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

1
test/tables.textile
View file

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

1
test/tables.txt
View file

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

1
test/tables.xwiki
View file

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

1
test/tables.zimwiki
View file

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

1
test/writer.custom
View file

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

2598
test/writer.docbook4
View file

File diff suppressed because it is too large Load diff

2521
test/writer.docbook5
View file

File diff suppressed because it is too large Load diff

1
test/writer.rst
View file

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

1
test/writer.textile
View file

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