From fc1c17b174eabf10f11bf45c4762569cce505956 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 16 Nov 2011 14:52:10 -0800 Subject: Added an asciidoc writer (partial). Still TODO: - documentation in README - add default.asciidoc to templates/ - lists - tables - proper escaping - footnotes with blank lines - print separately at end? currently they are just ignored. - fix header (date gives weird result on pandoc README) --- src/Text/Pandoc/Writers/Asciidoc.hs | 333 ++++++++++++++++++++++++++++++++++++ 1 file changed, 333 insertions(+) create mode 100644 src/Text/Pandoc/Writers/Asciidoc.hs (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs new file mode 100644 index 000000000..c8319764a --- /dev/null +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -0,0 +1,333 @@ +{-# LANGUAGE OverloadedStrings #-} +{- +Copyright (C) 2006-2010 John MacFarlane + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Writers.Asciidoc + Copyright : Copyright (C) 2006-2010 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane + Stability : alpha + Portability : portable + +Conversion of 'Pandoc' documents to asciidoc. + +Asciidoc: +-} +module Text.Pandoc.Writers.Asciidoc (writeAsciidoc) where +import Text.Pandoc.Definition +import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Shared +import Text.Pandoc.Parsing hiding (blankline) +import Text.ParserCombinators.Parsec ( runParser, GenParser ) +import Data.List ( isPrefixOf, intersperse, intercalate, transpose ) +import Text.Pandoc.Pretty +import Control.Monad.State + +data WriterState = WriterState { } + +-- | Convert Pandoc to Asciidoc. +writeAsciidoc :: WriterOptions -> Pandoc -> String +writeAsciidoc opts document = + evalState (pandocToAsciidoc opts document) WriterState{ } + +-- | Return markdown representation of document. +pandocToAsciidoc :: WriterOptions -> Pandoc -> State WriterState String +pandocToAsciidoc opts (Pandoc (Meta title authors date) blocks) = do + title' <- inlineListToAsciidoc opts title + let title'' = title' $$ text (replicate (offset title') '=') + authors' <- take 1 `fmap` mapM (inlineListToAsciidoc opts) authors + -- asciidoc only allows a singel author + date' <- inlineListToAsciidoc opts date + let titleblock = not $ null title && null authors && null date + body <- blockListToAsciidoc opts blocks + let colwidth = if writerWrapText opts + then Just $ writerColumns opts + else Nothing + let main = render colwidth body + let context = writerVariables opts ++ + [ ("body", main) + , ("title", render colwidth title'') + , ("date", render colwidth date') + ] ++ + [ ("toc", "yes") | writerTableOfContents opts && + writerStandalone opts ] ++ + [ ("titleblock", "yes") | titleblock ] ++ + [ ("author", render colwidth a) | a <- authors' ] + if writerStandalone opts + then return $ renderTemplate context $ writerTemplate opts + else return main + +-- | Escape special characters for Asciidoc. +escapeString :: String -> String +escapeString = escapeStringUsing markdownEscapes + where markdownEscapes = backslashEscapes "\\`*_>#~^{+" + +-- | Ordered list start parser for use in Para below. +olMarker :: GenParser Char ParserState Char +olMarker = do (start, style', delim) <- anyOrderedListMarker + if delim == Period && + (style' == UpperAlpha || (style' == UpperRoman && + start `elem` [1, 5, 10, 50, 100, 500, 1000])) + then spaceChar >> spaceChar + else spaceChar + +-- | True if string begins with an ordered list marker +beginsWithOrderedListMarker :: String -> Bool +beginsWithOrderedListMarker str = + case runParser olMarker defaultParserState "para start" (take 10 str) of + Left _ -> False + Right _ -> True + +-- | Convert Pandoc block element to markdown. +blockToAsciidoc :: WriterOptions -- ^ Options + -> Block -- ^ Block element + -> State WriterState Doc +blockToAsciidoc _ Null = return empty +blockToAsciidoc opts (Plain inlines) = do + contents <- inlineListToAsciidoc opts inlines + return $ contents <> cr +blockToAsciidoc opts (Para inlines) = do + contents <- inlineListToAsciidoc opts inlines + -- escape if para starts with ordered list marker + let esc = if beginsWithOrderedListMarker (render Nothing contents) + then text "\\" + else empty + return $ esc <> contents <> blankline +blockToAsciidoc _ (RawBlock f str) | f == "html" || f == "docbook" = do + return $ "+++" $$ text str $$ "+++" <> blankline +blockToAsciidoc _ (RawBlock _ _) = return empty +blockToAsciidoc _ HorizontalRule = + return $ blankline <> text "'''''" <> blankline +blockToAsciidoc opts (Header level inlines) = do + contents <- inlineListToAsciidoc opts inlines + let len = offset contents + return $ contents <> cr <> + (case level of + 1 -> text $ replicate len '-' + 2 -> text $ replicate len '~' + 3 -> text $ replicate len '^' + 4 -> text $ replicate len '+' + _ -> empty) <> blankline +blockToAsciidoc _ (CodeBlock (_,classes,_) str) = return $ + flush (attrs <> dashes <> space <> attrs <> cr <> text str <> + cr <> dashes) <> blankline + where dashes = text $ replicate (maximum $ map length $ lines str) '-' + attrs = if null classes + then empty + else text $ intercalate "," $ "code" : classes +blockToAsciidoc opts (BlockQuote blocks) = do + contents <- blockListToAsciidoc opts blocks + let cols = offset contents + let bar = text $ replicate cols '_' + return $ bar $$ contents $$ bar <> blankline +blockToAsciidoc opts (Table caption aligns widths headers rows) = do + caption' <- inlineListToAsciidoc opts caption + let caption'' = if null caption + then empty + else blankline <> ": " <> caption' <> blankline + headers' <- mapM (blockListToAsciidoc opts) headers + let alignHeader alignment = case alignment of + AlignLeft -> lblock + AlignCenter -> cblock + AlignRight -> rblock + AlignDefault -> lblock + rawRows <- mapM (mapM (blockListToAsciidoc opts)) rows + let isSimple = all (==0) widths + let numChars = maximum . map offset + let widthsInChars = + if isSimple + then map ((+2) . numChars) $ transpose (headers' : rawRows) + else map (floor . (fromIntegral (writerColumns opts) *)) widths + let makeRow = hcat . intersperse (lblock 1 (text " ")) . + (zipWith3 alignHeader aligns widthsInChars) + let rows' = map makeRow rawRows + let head' = makeRow headers' + let maxRowHeight = maximum $ map height (head':rows') + let underline = cat $ intersperse (text " ") $ + map (\width -> text (replicate width '-')) widthsInChars + let border = if maxRowHeight > 1 + then text (replicate (sum widthsInChars + + length widthsInChars - 1) '-') + else if all null headers + then underline + else empty + let head'' = if all null headers + then empty + else border <> cr <> head' + let body = if maxRowHeight > 1 + then vsep rows' + else vcat rows' + let bottom = if all null headers + then underline + else border + return $ nest 2 $ head'' $$ underline $$ body $$ + bottom $$ blankline $$ caption'' $$ blankline +blockToAsciidoc opts (BulletList items) = do + contents <- mapM (bulletListItemToAsciidoc opts) items + return $ cat contents <> blankline +blockToAsciidoc opts (OrderedList attribs items) = do + let markers = orderedListMarkers attribs + let markers' = map (\m -> if length m < 3 + then m ++ replicate (3 - length m) ' ' + else m) markers + contents <- mapM (\(item, num) -> orderedListItemToAsciidoc opts item num) $ + zip markers' items + return $ cat contents <> blankline +blockToAsciidoc opts (DefinitionList items) = do + contents <- mapM (definitionListItemToAsciidoc opts) items + return $ cat contents <> blankline + +-- | Convert bullet list item (list of blocks) to markdown. +bulletListItemToAsciidoc :: WriterOptions -> [Block] -> State WriterState Doc +bulletListItemToAsciidoc opts items = do + contents <- blockListToAsciidoc opts items + let sps = replicate (writerTabStop opts - 2) ' ' + let start = text ('-' : ' ' : sps) + return $ hang (writerTabStop opts) start $ contents <> cr + +-- | Convert ordered list item (a list of blocks) to markdown. +orderedListItemToAsciidoc :: WriterOptions -- ^ options + -> String -- ^ list item marker + -> [Block] -- ^ list item (list of blocks) + -> State WriterState Doc +orderedListItemToAsciidoc opts marker items = do + contents <- blockListToAsciidoc 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 + +-- | Convert definition list item (label, list of blocks) to markdown. +definitionListItemToAsciidoc :: WriterOptions + -> ([Inline],[[Block]]) + -> State WriterState Doc +definitionListItemToAsciidoc opts (label, defs) = do + labelText <- inlineListToAsciidoc opts label + let tabStop = writerTabStop opts + let leader = " ~" + let sps = case writerTabStop opts - 3 of + n | n > 0 -> text $ replicate n ' ' + _ -> text " " + defs' <- mapM (mapM (blockToAsciidoc opts)) defs + let contents = vcat $ map (\d -> hang tabStop (leader <> sps) $ vcat d <> cr) defs' + return $ labelText <> cr <> contents <> cr + +-- | Convert list of Pandoc block elements to markdown. +blockListToAsciidoc :: WriterOptions -- ^ Options + -> [Block] -- ^ List of block elements + -> State WriterState Doc +blockListToAsciidoc opts blocks = + mapM (blockToAsciidoc opts) (fixBlocks blocks) >>= return . cat + -- insert comment between list and indented code block, or the + -- code block will be treated as a list continuation paragraph + where fixBlocks (b : CodeBlock attr x : rest) + | (attr == nullAttr) && isListBlock b = + b : RawBlock "html" "\n" : CodeBlock attr x : + fixBlocks rest + fixBlocks (x : xs) = x : fixBlocks xs + fixBlocks [] = [] + isListBlock (BulletList _) = True + isListBlock (OrderedList _ _) = True + isListBlock (DefinitionList _) = True + isListBlock _ = False + +-- | Convert list of Pandoc inline elements to markdown. +inlineListToAsciidoc :: WriterOptions -> [Inline] -> State WriterState Doc +inlineListToAsciidoc opts lst = + mapM (inlineToAsciidoc opts) lst >>= return . cat + +-- | Convert Pandoc inline element to markdown. +inlineToAsciidoc :: WriterOptions -> Inline -> State WriterState Doc +inlineToAsciidoc opts (Emph lst) = do + contents <- inlineListToAsciidoc opts lst + return $ "_" <> contents <> "_" +inlineToAsciidoc opts (Strong lst) = do + contents <- inlineListToAsciidoc opts lst + return $ "*" <> contents <> "*" +inlineToAsciidoc opts (Strikeout lst) = do + contents <- inlineListToAsciidoc opts lst + return $ "[line-through]*" <> contents <> "*" +inlineToAsciidoc opts (Superscript lst) = do + contents <- inlineListToAsciidoc opts lst + return $ "^" <> contents <> "^" +inlineToAsciidoc opts (Subscript lst) = do + contents <- inlineListToAsciidoc opts lst + return $ "~" <> contents <> "~" +inlineToAsciidoc opts (SmallCaps lst) = inlineListToAsciidoc opts lst +inlineToAsciidoc opts (Quoted SingleQuote lst) = do + contents <- inlineListToAsciidoc opts lst + return $ "`" <> contents <> "'" +inlineToAsciidoc opts (Quoted DoubleQuote lst) = do + contents <- inlineListToAsciidoc opts lst + return $ "``" <> contents <> "''" +inlineToAsciidoc _ EmDash = return "\8212" +inlineToAsciidoc _ EnDash = return "\8211" +inlineToAsciidoc _ Apostrophe = return "\8217" +inlineToAsciidoc _ Ellipses = return "\8230" +inlineToAsciidoc _ (Code _ str) = return $ + text "`" <> text (escapeStringUsing (backslashEscapes "`") str) <> "`" +inlineToAsciidoc _ (Str str) = return $ text $ escapeString str +inlineToAsciidoc _ (Math InlineMath str) = + return $ "latexmath:[$" <> text str <> "$]" +inlineToAsciidoc _ (Math DisplayMath str) = + return $ "latexmath:[$$" <> text str <> "$$]" +inlineToAsciidoc _ (RawInline _ _) = return empty +inlineToAsciidoc _ (LineBreak) = return $ " +" <> cr +inlineToAsciidoc _ Space = return space +inlineToAsciidoc opts (Cite _ lst) = inlineListToAsciidoc opts lst +inlineToAsciidoc opts (Link txt (src', tit)) = do +-- relative: link:downloads/foo.zip[download foo.zip] +-- abs: http://google.cod[Google] +-- or my@email.com[email john] + linktext <- inlineListToAsciidoc opts txt + let linktitle = if null tit + then empty + else text $ ",title=\"" ++ tit ++ "\"" + let src = unescapeURI src' + let isRelative = ':' `elem` src + let prefix = if isRelative + then text "link:" + else empty + let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src + let useAuto = case (tit,txt) of + ("", [Code _ s]) | s == srcSuffix -> True + _ -> False + return $ if useAuto + then text srcSuffix + else prefix <> text src <> "[" <> linktext <> linktitle <> "]" +inlineToAsciidoc opts (Image alternate (src', tit)) = do +-- image:images/logo.png[Company logo, title="blah"] + let txt = if (null alternate) || (alternate == [Str ""]) + then [Str "image"] + else alternate + linktext <- inlineListToAsciidoc opts txt + let linktitle = if null tit + then empty + else text $ ",title=\"" ++ tit ++ "\"" + let src = unescapeURI src' + return $ "image:" <> text src <> "[" <> linktext <> linktitle <> "]" +inlineToAsciidoc opts (Note [Para inlines]) = + inlineToAsciidoc opts (Note [Plain inlines]) +inlineToAsciidoc opts (Note [Plain inlines]) = do + contents <- inlineListToAsciidoc opts inlines + return $ text "footnote:[" <> contents <> "]" +-- asciidoc can't handle blank lines in notes +inlineToAsciidoc _ (Note _) = return empty -- cgit v1.2.3 From b7cbd42d071a296220b3a08a1b2ea333150ca198 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 17 Nov 2011 00:52:45 -0800 Subject: Use attributes for author/date. --- src/Text/Pandoc/Writers/Asciidoc.hs | 2 +- templates | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index c8319764a..53b607cfc 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -52,7 +52,7 @@ pandocToAsciidoc :: WriterOptions -> Pandoc -> State WriterState String pandocToAsciidoc opts (Pandoc (Meta title authors date) blocks) = do title' <- inlineListToAsciidoc opts title let title'' = title' $$ text (replicate (offset title') '=') - authors' <- take 1 `fmap` mapM (inlineListToAsciidoc opts) authors + authors' <- mapM (inlineListToAsciidoc opts) authors -- asciidoc only allows a singel author date' <- inlineListToAsciidoc opts date let titleblock = not $ null title && null authors && null date diff --git a/templates b/templates index 8b89d7c97..279110eb7 160000 --- a/templates +++ b/templates @@ -1 +1 @@ -Subproject commit 8b89d7c975800f70024fd9a4204f615fec789463 +Subproject commit 279110eb7cfedd20e626cdeaaf94ccc6fbb1e8ab -- cgit v1.2.3 From fcfbbd2caa96e27e241a441629fcf6003f7a48da Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 17 Nov 2011 22:35:39 -0800 Subject: Supported definition lists. --- src/Text/Pandoc/Writers/Asciidoc.hs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index 53b607cfc..ff73ae7e6 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -40,12 +40,13 @@ import Data.List ( isPrefixOf, intersperse, intercalate, transpose ) import Text.Pandoc.Pretty import Control.Monad.State -data WriterState = WriterState { } +data WriterState = WriterState { defListMarker :: String } -- | Convert Pandoc to Asciidoc. writeAsciidoc :: WriterOptions -> Pandoc -> String writeAsciidoc opts document = - evalState (pandocToAsciidoc opts document) WriterState{ } + evalState (pandocToAsciidoc opts document) WriterState{ + defListMarker = "::" } -- | Return markdown representation of document. pandocToAsciidoc :: WriterOptions -> Pandoc -> State WriterState String @@ -221,14 +222,16 @@ definitionListItemToAsciidoc :: WriterOptions -> State WriterState Doc definitionListItemToAsciidoc opts (label, defs) = do labelText <- inlineListToAsciidoc opts label - let tabStop = writerTabStop opts - let leader = " ~" - let sps = case writerTabStop opts - 3 of - n | n > 0 -> text $ replicate n ' ' - _ -> text " " - defs' <- mapM (mapM (blockToAsciidoc opts)) defs - let contents = vcat $ map (\d -> hang tabStop (leader <> sps) $ vcat d <> cr) defs' - return $ labelText <> cr <> contents <> cr + marker <- defListMarker `fmap` get + if marker == "::" + then modify (\st -> st{ defListMarker = ";;"}) + else modify (\st -> st{ defListMarker = "::"}) + let defsToAsciidoc :: [Block] -> State WriterState Doc + defsToAsciidoc ds = vcat `fmap` mapM (blockToAsciidoc opts) ds + defs' <- mapM defsToAsciidoc defs + modify (\st -> st{ defListMarker = marker }) + let contents = nest 2 $ vsep defs' + return $ labelText <> text marker <> cr <> contents <> cr -- | Convert list of Pandoc block elements to markdown. blockListToAsciidoc :: WriterOptions -- ^ Options -- cgit v1.2.3 From 823c0bcda90dc060afd7c5026d194ddc9dec9409 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 17 Nov 2011 23:13:29 -0800 Subject: Indicate when a multiblock footnote is omitted. --- src/Text/Pandoc/Writers/Asciidoc.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index ff73ae7e6..aaa6964f1 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -333,4 +333,4 @@ inlineToAsciidoc opts (Note [Plain inlines]) = do contents <- inlineListToAsciidoc opts inlines return $ text "footnote:[" <> contents <> "]" -- asciidoc can't handle blank lines in notes -inlineToAsciidoc _ (Note _) = return empty +inlineToAsciidoc _ (Note _) = return "[multiblock footnote omitted]" -- cgit v1.2.3 From f6a0e75389d748818e703566b749af293195b4ee Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 18 Nov 2011 09:50:32 -0800 Subject: Supported tables in asciidoc, added table tests. --- src/Text/Pandoc/Writers/Asciidoc.hs | 92 +++++++++++++++++++++---------------- tests/tables.asciidoc | 72 ++++++++++++++++++++++++++++- 2 files changed, 124 insertions(+), 40 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index aaa6964f1..28c99b12a 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -36,7 +36,7 @@ import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Shared import Text.Pandoc.Parsing hiding (blankline) import Text.ParserCombinators.Parsec ( runParser, GenParser ) -import Data.List ( isPrefixOf, intersperse, intercalate, transpose ) +import Data.List ( isPrefixOf, intercalate ) import Text.Pandoc.Pretty import Control.Monad.State @@ -142,44 +142,58 @@ blockToAsciidoc opts (Table caption aligns widths headers rows) = do caption' <- inlineListToAsciidoc opts caption let caption'' = if null caption then empty - else blankline <> ": " <> caption' <> blankline - headers' <- mapM (blockListToAsciidoc opts) headers - let alignHeader alignment = case alignment of - AlignLeft -> lblock - AlignCenter -> cblock - AlignRight -> rblock - AlignDefault -> lblock - rawRows <- mapM (mapM (blockListToAsciidoc opts)) rows - let isSimple = all (==0) widths - let numChars = maximum . map offset - let widthsInChars = - if isSimple - then map ((+2) . numChars) $ transpose (headers' : rawRows) - else map (floor . (fromIntegral (writerColumns opts) *)) widths - let makeRow = hcat . intersperse (lblock 1 (text " ")) . - (zipWith3 alignHeader aligns widthsInChars) - let rows' = map makeRow rawRows - let head' = makeRow headers' - let maxRowHeight = maximum $ map height (head':rows') - let underline = cat $ intersperse (text " ") $ - map (\width -> text (replicate width '-')) widthsInChars - let border = if maxRowHeight > 1 - then text (replicate (sum widthsInChars + - length widthsInChars - 1) '-') - else if all null headers - then underline - else empty - let head'' = if all null headers - then empty - else border <> cr <> head' - let body = if maxRowHeight > 1 - then vsep rows' - else vcat rows' - let bottom = if all null headers - then underline - else border - return $ nest 2 $ head'' $$ underline $$ body $$ - bottom $$ blankline $$ caption'' $$ blankline + else "." <> caption' <> cr + let isSimple = all (== 0) widths + let relativePercentWidths = if isSimple + then widths + else map (/ (sum widths)) widths + let widths'' :: [Integer] + widths'' = map (floor . (* 100)) relativePercentWidths + -- ensure that the widths sum to 100 + let widths' = case widths'' of + _ | isSimple -> widths'' + (w:ws) | sum (w:ws) < 100 + -> (100 - sum ws) : ws + ws -> ws + let totalwidth :: Integer + totalwidth = floor $ sum widths * 100 + let colspec al wi = (case al of + AlignLeft -> "<" + AlignCenter -> "^" + AlignRight -> ">" + AlignDefault -> "") ++ + if wi == 0 then "" else (show wi ++ "%") + let headerspec = if all null headers + then empty + else text "options=\"header\"," + let widthspec = if totalwidth == 0 + then empty + else text "width=" + <> doubleQuotes (text $ show totalwidth ++ "%") + <> text "," + let tablespec = text "[" + <> widthspec + <> text "cols=" + <> doubleQuotes (text $ intercalate "," + $ zipWith colspec aligns widths') + <> text "," + <> headerspec <> text "]" + let makeCell [Plain x] = do d <- blockListToAsciidoc opts [Plain x] + return $ text "|" <> chomp d + makeCell [Para x] = makeCell [Plain x] + makeCell _ = return $ text "|" <> "[multiblock cell omitted]" + let makeRow cells = hsep `fmap` mapM makeCell cells + rows' <- mapM makeRow rows + head' <- makeRow headers + let head'' = if all null headers then empty else head' + let colwidth = if writerWrapText opts + then writerColumns opts + else 100000 + let maxwidth = maximum $ map offset (head':rows') + let body = if maxwidth > colwidth then vsep rows' else vcat rows' + let border = text $ "|" ++ replicate ((min maxwidth colwidth) - 1) '=' + return $ + caption'' $$ tablespec $$ border $$ head'' $$ body $$ border $$ blankline blockToAsciidoc opts (BulletList items) = do contents <- mapM (bulletListItemToAsciidoc opts) items return $ cat contents <> blankline diff --git a/tests/tables.asciidoc b/tests/tables.asciidoc index 48cdce852..842a9b8c4 100644 --- a/tests/tables.asciidoc +++ b/tests/tables.asciidoc @@ -1 +1,71 @@ -placeholder +Simple table with caption: + +.Demonstration of simple table syntax. +[cols=">,<,^,",options="header",] +|============================ +|Right |Left |Center |Default +|12 |12 |12 |12 +|123 |123 |123 |123 +|1 |1 |1 |1 +|============================ + +Simple table without caption: + +[cols=">,<,^,",options="header",] +|============================ +|Right |Left |Center |Default +|12 |12 |12 |12 +|123 |123 |123 |123 +|1 |1 |1 |1 +|============================ + +Simple table indented two spaces: + +.Demonstration of simple table syntax. +[cols=">,<,^,",options="header",] +|============================ +|Right |Left |Center |Default +|12 |12 |12 |12 +|123 |123 |123 |123 +|1 |1 |1 |1 +|============================ + +Multiline table with caption: + +.Here's the caption. It may span multiple lines. +[width="78%",cols="^21%,<17%,>20%,<42%",options="header",] +|======================================================================= +|Centered Header |Left Aligned |Right Aligned |Default aligned +|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. +|======================================================================= + +Multiline table without caption: + +[width="78%",cols="^21%,<17%,>20%,<42%",options="header",] +|======================================================================= +|Centered Header |Left Aligned |Right Aligned |Default aligned +|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. +|======================================================================= + +Table without column headers: + +[cols=">,<,^,>",] +|======================================================================= +|12 |12 |12 |12 + +|123 |123 |123 |123 + +|1 |1 |1 |1 +|======================================================================= + +Multiline table without column headers: + +[width="78%",cols="^21%,<17%,>20%,42%",] +|======================================================================= +|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. +|======================================================================= + -- cgit v1.2.3 From e8e5ad210fa4bd49775822951e2b3352bec2c7e0 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 18 Nov 2011 13:23:09 -0800 Subject: Added comment about limitations of asciidoc conversion. --- src/Text/Pandoc/Writers/Asciidoc.hs | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index 28c99b12a..f51c43362 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -28,6 +28,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to asciidoc. +Note that some information may be lost in conversion, due to +expressive limitations of asciidoc. Footnotes and table cells with +paragraphs (or other block items) are not possible in asciidoc. +If pandoc encounters one of these, it will insert a message indicating +that it has omitted the construct. + Asciidoc: -} module Text.Pandoc.Writers.Asciidoc (writeAsciidoc) where -- cgit v1.2.3 From a9a4e24d29542c16e0b31388a46e5bd808f35539 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 18 Nov 2011 17:01:38 -0800 Subject: Added fields to track list levels. --- src/Text/Pandoc/Writers/Asciidoc.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index f51c43362..45aa2cbee 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -46,13 +46,19 @@ import Data.List ( isPrefixOf, intercalate ) import Text.Pandoc.Pretty import Control.Monad.State -data WriterState = WriterState { defListMarker :: String } +data WriterState = WriterState { defListMarker :: String + , orderedListLevel :: Int + , bulletListLevel :: Int + } -- | Convert Pandoc to Asciidoc. writeAsciidoc :: WriterOptions -> Pandoc -> String writeAsciidoc opts document = evalState (pandocToAsciidoc opts document) WriterState{ - defListMarker = "::" } + defListMarker = "::" + , orderedListLevel = 1 + , bulletListLevel = 1 + } -- | Return markdown representation of document. pandocToAsciidoc :: WriterOptions -> Pandoc -> State WriterState String -- cgit v1.2.3 From 40c7d096ccbc2f4bb0c0b4b79ba332c2542e997a Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 18 Nov 2011 17:50:41 -0800 Subject: Implemented bullet lists in asciidoc writer. --- src/Text/Pandoc/Writers/Asciidoc.hs | 39 +++++++++++++++++-------------------- 1 file changed, 18 insertions(+), 21 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index 45aa2cbee..2ef5b45bb 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -209,8 +209,8 @@ blockToAsciidoc opts (Table caption aligns widths headers rows) = do blockToAsciidoc opts (BulletList items) = do contents <- mapM (bulletListItemToAsciidoc opts) items return $ cat contents <> blankline -blockToAsciidoc opts (OrderedList attribs items) = do - let markers = orderedListMarkers attribs +blockToAsciidoc opts (OrderedList (start, sty, _delim) items) = do + let markers = orderedListMarkers (start, sty, Period) let markers' = map (\m -> if length m < 3 then m ++ replicate (3 - length m) ' ' else m) markers @@ -223,11 +223,21 @@ blockToAsciidoc opts (DefinitionList items) = do -- | Convert bullet list item (list of blocks) to markdown. bulletListItemToAsciidoc :: WriterOptions -> [Block] -> State WriterState Doc -bulletListItemToAsciidoc opts items = do - contents <- blockListToAsciidoc opts items - let sps = replicate (writerTabStop opts - 2) ' ' - let start = text ('-' : ' ' : sps) - return $ hang (writerTabStop opts) start $ contents <> cr +bulletListItemToAsciidoc opts blocks = do + let addBlock :: Doc -> Block -> State WriterState Doc + addBlock d b | isEmpty d = chomp `fmap` blockToAsciidoc opts b + addBlock d b@(BulletList _) = do x <- blockToAsciidoc opts b + return $ d <> cr <> chomp x + addBlock d b@(OrderedList _ _) = do x <- blockToAsciidoc opts b + return $ d <> cr <> chomp x + addBlock d b = do x <- blockToAsciidoc opts b + return $ d <> cr <> text "+" <> cr <> chomp x + lev <- bulletListLevel `fmap` get + modify $ \s -> s{ bulletListLevel = lev + 1 } + contents <- foldM addBlock empty blocks + modify $ \s -> s{ bulletListLevel = lev } + let marker = text (replicate lev '*') + return $ marker <> space <> contents <> cr -- | Convert ordered list item (a list of blocks) to markdown. orderedListItemToAsciidoc :: WriterOptions -- ^ options @@ -263,20 +273,7 @@ definitionListItemToAsciidoc opts (label, defs) = do blockListToAsciidoc :: WriterOptions -- ^ Options -> [Block] -- ^ List of block elements -> State WriterState Doc -blockListToAsciidoc opts blocks = - mapM (blockToAsciidoc opts) (fixBlocks blocks) >>= return . cat - -- insert comment between list and indented code block, or the - -- code block will be treated as a list continuation paragraph - where fixBlocks (b : CodeBlock attr x : rest) - | (attr == nullAttr) && isListBlock b = - b : RawBlock "html" "\n" : CodeBlock attr x : - fixBlocks rest - fixBlocks (x : xs) = x : fixBlocks xs - fixBlocks [] = [] - isListBlock (BulletList _) = True - isListBlock (OrderedList _ _) = True - isListBlock (DefinitionList _) = True - isListBlock _ = False +blockListToAsciidoc opts blocks = cat `fmap` mapM (blockToAsciidoc opts) blocks -- | Convert list of Pandoc inline elements to markdown. inlineListToAsciidoc :: WriterOptions -> [Inline] -> State WriterState Doc -- cgit v1.2.3 From 11f6177670a7e0b15a42c7576a988c083d9c77e2 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 18 Nov 2011 18:19:47 -0800 Subject: Implemented ordered lists in asciidoc. --- src/Text/Pandoc/Writers/Asciidoc.hs | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index 2ef5b45bb..a3df93a3c 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -244,13 +244,20 @@ orderedListItemToAsciidoc :: WriterOptions -- ^ options -> String -- ^ list item marker -> [Block] -- ^ list item (list of blocks) -> State WriterState Doc -orderedListItemToAsciidoc opts marker items = do - contents <- blockListToAsciidoc 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 +orderedListItemToAsciidoc opts marker blocks = do + let addBlock :: Doc -> Block -> State WriterState Doc + addBlock d b | isEmpty d = chomp `fmap` blockToAsciidoc opts b + addBlock d b@(BulletList _) = do x <- blockToAsciidoc opts b + return $ d <> cr <> chomp x + addBlock d b@(OrderedList _ _) = do x <- blockToAsciidoc opts b + return $ d <> cr <> chomp x + addBlock d b = do x <- blockToAsciidoc opts b + return $ d <> cr <> text "+" <> cr <> chomp x + lev <- orderedListLevel `fmap` get + modify $ \s -> s{ orderedListLevel = lev + 1 } + contents <- foldM addBlock empty blocks + modify $ \s -> s{ orderedListLevel = lev } + return $ text marker <> space <> contents <> cr -- | Convert definition list item (label, list of blocks) to markdown. definitionListItemToAsciidoc :: WriterOptions -- cgit v1.2.3 From 965c9415b0daed39e5c7d43f413d99b32645cc2f Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 18 Nov 2011 18:22:09 -0800 Subject: Ensure blank line before html passthrough. --- src/Text/Pandoc/Writers/Asciidoc.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index a3df93a3c..d4c9e3c33 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -124,7 +124,7 @@ blockToAsciidoc opts (Para inlines) = do else empty return $ esc <> contents <> blankline blockToAsciidoc _ (RawBlock f str) | f == "html" || f == "docbook" = do - return $ "+++" $$ text str $$ "+++" <> blankline + return $ blankline $$ "+++" $$ text str $$ "+++" <> blankline blockToAsciidoc _ (RawBlock _ _) = return empty blockToAsciidoc _ HorizontalRule = return $ blankline <> text "'''''" <> blankline -- cgit v1.2.3 From f5af4903dfdad6b849f708f476832bdb07cca6a7 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 18 Nov 2011 18:31:32 -0800 Subject: Removed link title in asciidoc. Apparently it is not supported. --- src/Text/Pandoc/Writers/Asciidoc.hs | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index d4c9e3c33..f88594680 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -326,26 +326,23 @@ inlineToAsciidoc _ (RawInline _ _) = return empty inlineToAsciidoc _ (LineBreak) = return $ " +" <> cr inlineToAsciidoc _ Space = return space inlineToAsciidoc opts (Cite _ lst) = inlineListToAsciidoc opts lst -inlineToAsciidoc opts (Link txt (src', tit)) = do +inlineToAsciidoc opts (Link txt (src', _tit)) = do -- relative: link:downloads/foo.zip[download foo.zip] -- abs: http://google.cod[Google] -- or my@email.com[email john] linktext <- inlineListToAsciidoc opts txt - let linktitle = if null tit - then empty - else text $ ",title=\"" ++ tit ++ "\"" let src = unescapeURI src' - let isRelative = ':' `elem` src + let isRelative = ':' `notElem` src let prefix = if isRelative then text "link:" else empty let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src - let useAuto = case (tit,txt) of - ("", [Code _ s]) | s == srcSuffix -> True - _ -> False + let useAuto = case txt of + [Code _ s] | s == srcSuffix -> True + _ -> False return $ if useAuto then text srcSuffix - else prefix <> text src <> "[" <> linktext <> linktitle <> "]" + else prefix <> text src <> "[" <> linktext <> "]" inlineToAsciidoc opts (Image alternate (src', tit)) = do -- image:images/logo.png[Company logo, title="blah"] let txt = if (null alternate) || (alternate == [Str ""]) -- cgit v1.2.3 From 457571e0c896d7ffbd7f53c9df4a9067d9ba0f68 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 18 Nov 2011 19:38:00 -0800 Subject: Fixed continuations in asciidoc definition lists. --- src/Text/Pandoc/Writers/Asciidoc.hs | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index f88594680..a4ed7f98d 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -42,7 +42,7 @@ import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Shared import Text.Pandoc.Parsing hiding (blankline) import Text.ParserCombinators.Parsec ( runParser, GenParser ) -import Data.List ( isPrefixOf, intercalate ) +import Data.List ( isPrefixOf, intersperse, intercalate ) import Text.Pandoc.Pretty import Control.Monad.State @@ -147,9 +147,15 @@ blockToAsciidoc _ (CodeBlock (_,classes,_) str) = return $ else text $ intercalate "," $ "code" : classes blockToAsciidoc opts (BlockQuote blocks) = do contents <- blockListToAsciidoc opts blocks - let cols = offset contents + let isBlock (BlockQuote _) = True + isBlock _ = False + -- if there are nested block quotes, put in an open block + let contents' = if any isBlock blocks + then "--" $$ contents $$ "--" + else contents + let cols = offset contents' let bar = text $ replicate cols '_' - return $ bar $$ contents $$ bar <> blankline + return $ bar $$ chomp contents' $$ bar <> blankline blockToAsciidoc opts (Table caption aligns widths headers rows) = do caption' <- inlineListToAsciidoc opts caption let caption'' = if null caption @@ -269,11 +275,13 @@ definitionListItemToAsciidoc opts (label, defs) = do if marker == "::" then modify (\st -> st{ defListMarker = ";;"}) else modify (\st -> st{ defListMarker = "::"}) + let divider = cr <> text "+" <> cr let defsToAsciidoc :: [Block] -> State WriterState Doc - defsToAsciidoc ds = vcat `fmap` mapM (blockToAsciidoc opts) ds + defsToAsciidoc ds = (vcat . intersperse divider . map chomp) + `fmap` mapM (blockToAsciidoc opts) ds defs' <- mapM defsToAsciidoc defs modify (\st -> st{ defListMarker = marker }) - let contents = nest 2 $ vsep defs' + let contents = nest 2 $ vcat $ intersperse divider $ map chomp defs' return $ labelText <> text marker <> cr <> contents <> cr -- | Convert list of Pandoc block elements to markdown. -- cgit v1.2.3 From c1710f9bde6d84da4a40c825da558714cf058e25 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 18 Nov 2011 19:44:15 -0800 Subject: Skip raw HTML blocks in asciidoc. --- src/Text/Pandoc/Writers/Asciidoc.hs | 2 -- 1 file changed, 2 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/Asciidoc.hs b/src/Text/Pandoc/Writers/Asciidoc.hs index a4ed7f98d..91930ac68 100644 --- a/src/Text/Pandoc/Writers/Asciidoc.hs +++ b/src/Text/Pandoc/Writers/Asciidoc.hs @@ -123,8 +123,6 @@ blockToAsciidoc opts (Para inlines) = do then text "\\" else empty return $ esc <> contents <> blankline -blockToAsciidoc _ (RawBlock f str) | f == "html" || f == "docbook" = do - return $ blankline $$ "+++" $$ text str $$ "+++" <> blankline blockToAsciidoc _ (RawBlock _ _) = return empty blockToAsciidoc _ HorizontalRule = return $ blankline <> text "'''''" <> blankline -- cgit v1.2.3