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