pandoc/src/Text/Pandoc/Writers/Asciidoc.hs

357 lines
15 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
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 <jgm@berkeley.edu>
Stability : alpha
Portability : portable
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: <http://www.methods.co.nz/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, intercalate )
import Text.Pandoc.Pretty
import Control.Monad.State
2011-11-17 22:35:39 -08:00
data WriterState = WriterState { defListMarker :: String }
-- | Convert Pandoc to Asciidoc.
writeAsciidoc :: WriterOptions -> Pandoc -> String
writeAsciidoc opts document =
2011-11-17 22:35:39 -08:00
evalState (pandocToAsciidoc opts document) WriterState{
defListMarker = "::" }
-- | 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') '=')
2011-11-17 00:52:45 -08:00
authors' <- 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 "." <> 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
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
2011-11-17 22:35:39 -08:00
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
-> [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 "[multiblock footnote omitted]"