diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/AsciiDoc.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/AsciiDoc.hs | 159 |
1 files changed, 90 insertions, 69 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index e9d3dccf1..f91fa8fa0 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2006-2015 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2006-2018 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 @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.AsciiDoc - Copyright : Copyright (C) 2006-2015 John MacFarlane + Copyright : Copyright (C) 2006-2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -37,49 +37,59 @@ that it has omitted the construct. AsciiDoc: <http://www.methods.co.nz/asciidoc/> -} module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where +import Control.Monad.State.Strict +import Data.Aeson (Result (..), Value (String), fromJSON, toJSON) +import Data.Char (isPunctuation, isSpace) +import Data.List (intercalate, intersperse, stripPrefix) +import qualified Data.Map as M +import Data.Maybe (fromMaybe, isJust) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T +import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition -import Text.Pandoc.Templates (renderTemplate') -import Text.Pandoc.Shared -import Text.Pandoc.Writers.Shared +import Text.Pandoc.ImageSize +import Text.Pandoc.Logging import Text.Pandoc.Options import Text.Pandoc.Parsing hiding (blankline, space) -import Data.Maybe (fromMaybe) -import Data.List ( stripPrefix, intersperse, intercalate ) import Text.Pandoc.Pretty -import Text.Pandoc.ImageSize -import Control.Monad.State -import qualified Data.Map as M -import Data.Aeson (Value(String), fromJSON, toJSON, Result(..)) -import qualified Data.Text as T -import Data.Char (isSpace, isPunctuation) +import Text.Pandoc.Shared +import Text.Pandoc.Templates (renderTemplate') +import Text.Pandoc.Writers.Shared -data WriterState = WriterState { defListMarker :: String +data WriterState = WriterState { defListMarker :: String , orderedListLevel :: Int , bulletListLevel :: Int , intraword :: Bool + , autoIds :: Set.Set String } -- | Convert Pandoc to AsciiDoc. -writeAsciiDoc :: WriterOptions -> Pandoc -> String +writeAsciiDoc :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeAsciiDoc opts document = - evalState (pandocToAsciiDoc opts document) WriterState{ + evalStateT (pandocToAsciiDoc opts document) WriterState{ defListMarker = "::" , orderedListLevel = 1 , bulletListLevel = 1 , intraword = False + , autoIds = Set.empty } +type ADW = StateT WriterState + -- | Return asciidoc representation of document. -pandocToAsciiDoc :: WriterOptions -> Pandoc -> State WriterState String +pandocToAsciiDoc :: PandocMonad m => WriterOptions -> Pandoc -> ADW m Text pandocToAsciiDoc opts (Pandoc meta blocks) = do let titleblock = not $ null (docTitle meta) && null (docAuthors meta) && null (docDate meta) let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing + let render' :: Doc -> Text + render' = render colwidth metadata <- metaToJSON opts - (fmap (render colwidth) . blockListToAsciiDoc opts) - (fmap (render colwidth) . inlineListToAsciiDoc opts) + (fmap render' . blockListToAsciiDoc opts) + (fmap render' . inlineListToAsciiDoc opts) meta let addTitleLine (String t) = String $ t <> "\n" <> T.replicate (T.length t) "=" @@ -93,12 +103,11 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do let context = defField "body" main $ defField "toc" (writerTableOfContents opts && - writerTemplate opts /= Nothing) - $ defField "titleblock" titleblock - $ metadata' + isJust (writerTemplate opts)) + $defField "titleblock" titleblock metadata' case writerTemplate opts of Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Escape special characters for AsciiDoc. escapeString :: String -> String @@ -118,18 +127,19 @@ olMarker = do (start, style', delim) <- anyOrderedListMarker beginsWithOrderedListMarker :: String -> Bool beginsWithOrderedListMarker str = case runParser olMarker defaultParserState "para start" (take 10 str) of - Left _ -> False - Right _ -> True + Left _ -> False + Right _ -> True -- | Convert Pandoc block element to asciidoc. -blockToAsciiDoc :: WriterOptions -- ^ Options +blockToAsciiDoc :: PandocMonad m + => WriterOptions -- ^ Options -> Block -- ^ Block element - -> State WriterState Doc + -> ADW m Doc blockToAsciiDoc _ Null = return empty blockToAsciiDoc opts (Plain inlines) = do contents <- inlineListToAsciiDoc opts inlines return $ contents <> blankline -blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do +blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = blockToAsciiDoc opts (Para [Image attr alt (src,tit)]) blockToAsciiDoc opts (Para inlines) = do contents <- inlineListToAsciiDoc opts inlines @@ -145,9 +155,11 @@ blockToAsciiDoc opts (LineBlock lns) = do let joinWithLinefeeds = nowrap . mconcat . intersperse cr contents <- joinWithLinefeeds <$> mapM docify lns return $ "[verse]" $$ text "--" $$ contents $$ text "--" $$ blankline -blockToAsciiDoc _ (RawBlock f s) +blockToAsciiDoc _ b@(RawBlock f s) | f == "asciidoc" = return $ text s - | otherwise = return empty + | otherwise = do + report $ BlockNotRendered b + return empty blockToAsciiDoc _ HorizontalRule = return $ blankline <> text "'''''" <> blankline blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do @@ -155,21 +167,25 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do let len = offset contents -- ident seem to be empty most of the time and asciidoc will generate them automatically -- so lets make them not show up when null - let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + ids <- gets autoIds + let autoId = uniqueIdent inlines ids + modify $ \st -> st{ autoIds = Set.insert autoId ids } + let identifier = if null ident || (isEnabled Ext_auto_identifiers opts && ident == autoId) + then empty else "[[" <> text ident <> "]]" let setext = writerSetextHeaders opts - return $ + return (if setext then identifier $$ contents $$ (case level of - 1 -> text $ replicate len '-' - 2 -> text $ replicate len '~' - 3 -> text $ replicate len '^' - 4 -> text $ replicate len '+' - _ -> empty) <> blankline + 1 -> text $ replicate len '-' + 2 -> text $ replicate len '~' + 3 -> text $ replicate len '^' + 4 -> text $ replicate len '+' + _ -> empty) <> blankline else identifier $$ text (replicate level '=') <> space <> contents <> blankline) -blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ (flush $ +blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ flush ( if null classes then "...." $$ text str $$ "...." else attrs $$ "----" $$ text str $$ "----") @@ -194,7 +210,7 @@ blockToAsciiDoc opts (Table caption aligns widths headers rows) = do let isSimple = all (== 0) widths let relativePercentWidths = if isSimple then widths - else map (/ (sum widths)) widths + else map (/ sum widths) widths let widths'' :: [Integer] widths'' = map (floor . (* 100)) relativePercentWidths -- ensure that the widths sum to 100 @@ -210,7 +226,7 @@ blockToAsciiDoc opts (Table caption aligns widths headers rows) = do AlignCenter -> "^" AlignRight -> ">" AlignDefault -> "") ++ - if wi == 0 then "" else (show wi ++ "%") + if wi == 0 then "" else show wi ++ "%" let headerspec = if all null headers then empty else text "options=\"header\"," @@ -256,21 +272,21 @@ blockToAsciiDoc opts (OrderedList (_start, sty, _delim) items) = do 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 + contents <- zipWithM (orderedListItemToAsciiDoc opts) markers' items return $ cat contents <> blankline blockToAsciiDoc opts (DefinitionList items) = do contents <- mapM (definitionListItemToAsciiDoc opts) items return $ cat contents <> blankline blockToAsciiDoc opts (Div (ident,_,_) bs) = do - let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + let identifier = if null ident then empty else ("[[" <> text ident <> "]]") contents <- blockListToAsciiDoc opts bs return $ identifier $$ contents -- | Convert bullet list item (list of blocks) to asciidoc. -bulletListItemToAsciiDoc :: WriterOptions -> [Block] -> State WriterState Doc +bulletListItemToAsciiDoc :: PandocMonad m + => WriterOptions -> [Block] -> ADW m Doc bulletListItemToAsciiDoc opts blocks = do - let addBlock :: Doc -> Block -> State WriterState Doc + let addBlock :: PandocMonad m => Doc -> Block -> ADW m 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 @@ -278,7 +294,7 @@ bulletListItemToAsciiDoc opts blocks = do return $ d <> cr <> chomp x addBlock d b = do x <- blockToAsciiDoc opts b return $ d <> cr <> text "+" <> cr <> chomp x - lev <- bulletListLevel `fmap` get + lev <- gets bulletListLevel modify $ \s -> s{ bulletListLevel = lev + 1 } contents <- foldM addBlock empty blocks modify $ \s -> s{ bulletListLevel = lev } @@ -286,37 +302,38 @@ bulletListItemToAsciiDoc opts blocks = do return $ marker <> text " " <> contents <> cr -- | Convert ordered list item (a list of blocks) to asciidoc. -orderedListItemToAsciiDoc :: WriterOptions -- ^ options +orderedListItemToAsciiDoc :: PandocMonad m + => WriterOptions -- ^ options -> String -- ^ list item marker -> [Block] -- ^ list item (list of blocks) - -> State WriterState Doc + -> ADW m Doc orderedListItemToAsciiDoc opts marker blocks = do - let addBlock :: Doc -> Block -> State WriterState Doc - addBlock d b | isEmpty d = chomp `fmap` blockToAsciiDoc opts b + let 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 + lev <- gets orderedListLevel modify $ \s -> s{ orderedListLevel = lev + 1 } contents <- foldM addBlock empty blocks modify $ \s -> s{ orderedListLevel = lev } return $ text marker <> text " " <> contents <> cr -- | Convert definition list item (label, list of blocks) to asciidoc. -definitionListItemToAsciiDoc :: WriterOptions +definitionListItemToAsciiDoc :: PandocMonad m + => WriterOptions -> ([Inline],[[Block]]) - -> State WriterState Doc + -> ADW m Doc definitionListItemToAsciiDoc opts (label, defs) = do labelText <- inlineListToAsciiDoc opts label - marker <- defListMarker `fmap` get + marker <- gets defListMarker if marker == "::" then modify (\st -> st{ defListMarker = ";;"}) else modify (\st -> st{ defListMarker = "::"}) let divider = cr <> text "+" <> cr - let defsToAsciiDoc :: [Block] -> State WriterState Doc + let defsToAsciiDoc :: PandocMonad m => [Block] -> ADW m Doc defsToAsciiDoc ds = (vcat . intersperse divider . map chomp) `fmap` mapM (blockToAsciiDoc opts) ds defs' <- mapM defsToAsciiDoc defs @@ -325,15 +342,16 @@ definitionListItemToAsciiDoc opts (label, defs) = do return $ labelText <> text marker <> cr <> contents <> cr -- | Convert list of Pandoc block elements to asciidoc. -blockListToAsciiDoc :: WriterOptions -- ^ Options +blockListToAsciiDoc :: PandocMonad m + => WriterOptions -- ^ Options -> [Block] -- ^ List of block elements - -> State WriterState Doc + -> ADW m Doc blockListToAsciiDoc opts blocks = cat `fmap` mapM (blockToAsciiDoc opts) blocks data SpacyLocation = End | Start -- | Convert list of Pandoc inline elements to asciidoc. -inlineListToAsciiDoc :: WriterOptions -> [Inline] -> State WriterState Doc +inlineListToAsciiDoc :: PandocMonad m => WriterOptions -> [Inline] -> ADW m Doc inlineListToAsciiDoc opts lst = do oldIntraword <- gets intraword setIntraword False @@ -369,14 +387,14 @@ inlineListToAsciiDoc opts lst = do isSpacy Start (Str (c:_)) = isPunctuation c || isSpace c isSpacy _ _ = False -setIntraword :: Bool -> State WriterState () +setIntraword :: PandocMonad m => Bool -> ADW m () setIntraword b = modify $ \st -> st{ intraword = b } -withIntraword :: State WriterState a -> State WriterState a +withIntraword :: PandocMonad m => ADW m a -> ADW m a withIntraword p = setIntraword True *> p <* setIntraword False -- | Convert Pandoc inline element to asciidoc. -inlineToAsciiDoc :: WriterOptions -> Inline -> State WriterState Doc +inlineToAsciiDoc :: PandocMonad m => WriterOptions -> Inline -> ADW m Doc inlineToAsciiDoc opts (Emph lst) = do contents <- inlineListToAsciiDoc opts lst isIntraword <- gets intraword @@ -408,16 +426,19 @@ inlineToAsciiDoc _ (Math InlineMath str) = return $ "latexmath:[$" <> text str <> "$]" inlineToAsciiDoc _ (Math DisplayMath str) = return $ "latexmath:[\\[" <> text str <> "\\]]" -inlineToAsciiDoc _ (RawInline f s) +inlineToAsciiDoc _ il@(RawInline f s) | f == "asciidoc" = return $ text s + | otherwise = do + report $ InlineNotRendered il + return empty | otherwise = return empty -inlineToAsciiDoc _ (LineBreak) = return $ " +" <> cr +inlineToAsciiDoc _ LineBreak = return $ " +" <> cr inlineToAsciiDoc _ Space = return space inlineToAsciiDoc opts SoftBreak = case writerWrapText opts of - WrapAuto -> return space + WrapAuto -> return space WrapPreserve -> return cr - WrapNone -> return space + WrapNone -> return space inlineToAsciiDoc opts (Cite _ lst) = inlineListToAsciiDoc opts lst inlineToAsciiDoc opts (Link _ txt (src, _tit)) = do -- relative: link:downloads/foo.zip[download foo.zip] @@ -431,20 +452,20 @@ inlineToAsciiDoc opts (Link _ txt (src, _tit)) = do let srcSuffix = fromMaybe src (stripPrefix "mailto:" src) let useAuto = case txt of [Str s] | escapeURI s == srcSuffix -> True - _ -> False + _ -> False return $ if useAuto then text srcSuffix else prefix <> text src <> "[" <> linktext <> "]" inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do -- image:images/logo.png[Company logo, title="blah"] - let txt = if (null alternate) || (alternate == [Str ""]) + let txt = if null alternate || (alternate == [Str ""]) then [Str "image"] else alternate linktext <- inlineListToAsciiDoc opts txt let linktitle = if null tit then empty else ",title=\"" <> text tit <> "\"" - showDim dir = case (dimension dir attr) of + showDim dir = case dimension dir attr of Just (Percent a) -> ["scaledwidth=" <> text (show (Percent a))] Just dim -> @@ -464,6 +485,6 @@ inlineToAsciiDoc opts (Note [Plain inlines]) = do -- asciidoc can't handle blank lines in notes inlineToAsciiDoc _ (Note _) = return "[multiblock footnote omitted]" inlineToAsciiDoc opts (Span (ident,_,_) ils) = do - let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + let identifier = if null ident then empty else ("[[" <> text ident <> "]]") contents <- inlineListToAsciiDoc opts ils return $ identifier <> contents |