From 2c13773be857357152750fd3c809326420caca31 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 20 Dec 2019 17:12:46 +0100 Subject: Jira writer: use jira-wiki-markup renderer Pandoc's AST is translated into the Jira AST, which is then rendered by the dedicated Jira printer. The following improvements are included in this change: - non-jira raw blocks are fully discarded instead of showing as blank lines; - table cells can contain multiple blocks; - unnecessary blank lines are removed from the output; - markup chars within words are properly surrounded by braces; - preserving soft linebreaks via `--wrap=preserve` is supported. Note that backslashes are rendered as HTML entities, as there appears no alternative to produce a plain backslash if it is followed by markup. This may cause problems when used with confluence, where rendering seems to fail in this case. Closes: #5926 --- src/Text/Pandoc/Writers/Jira.hs | 488 ++++++++++++++++++---------------------- 1 file changed, 222 insertions(+), 266 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs index 2a2470209..ccb0ff187 100644 --- a/src/Text/Pandoc/Writers/Jira.hs +++ b/src/Text/Pandoc/Writers/Jira.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} {- | @@ -16,296 +17,251 @@ JIRA: -} module Text.Pandoc.Writers.Jira ( writeJira ) where import Prelude -import Control.Monad.State.Strict +import Control.Monad.Reader (ReaderT, ask, asks, runReaderT) +import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) import Data.Foldable (find) -import Data.Text (Text, pack) -import Text.Pandoc.Class (PandocMonad, report) +import Data.Text (Text) +import Text.Jira.Parser (plainText) +import Text.Jira.Printer (prettyBlocks, prettyInlines) +import Text.Pandoc.Class (PandocMonad) import Text.Pandoc.Definition -import Text.Pandoc.Logging (LogMessage (BlockNotRendered, InlineNotRendered)) -import Text.Pandoc.Options (WriterOptions (writerTemplate)) -import Text.Pandoc.Shared (blocksToInlines, linesToPara) +import Text.Pandoc.Options (WriterOptions (writerTemplate, writerWrapText), + WrapOption (..)) +import Text.Pandoc.Shared (linesToPara) import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Writers.Math (texMathToInlines) -import Text.Pandoc.Writers.Shared (metaToContext, defField) -import qualified Data.Text as T +import Text.Pandoc.Writers.Shared (defField, metaToContext) import Text.DocLayout (literal, render) +import qualified Data.Text as T +import qualified Text.Jira.Markup as Jira -data WriterState = WriterState - { stNotes :: [Text] -- Footnotes - , stListLevel :: Text -- String at beginning of list items, e.g. "**" - } +-- | Convert Pandoc to Jira. +writeJira :: PandocMonad m => WriterOptions -> Pandoc -> m Text +writeJira opts = runDefaultConverter (writerWrapText opts) (pandocToJira opts) --- | Initial writer state -startState :: WriterState -startState = WriterState - { stNotes = [] - , stListLevel = "" - } +-- | State to keep track of footnotes. +newtype ConverterState = ConverterState { stNotes :: [Text] } -type JiraWriter = StateT WriterState +-- | Initial converter state. +startState :: ConverterState +startState = ConverterState { stNotes = [] } --- | Convert Pandoc to Jira. -writeJira :: PandocMonad m => WriterOptions -> Pandoc -> m Text -writeJira opts document = - evalStateT (pandocToJira opts document) startState +-- | Converter monad +type JiraConverter m = ReaderT WrapOption (StateT ConverterState m) + +-- | Run a converter using the default state +runDefaultConverter :: PandocMonad m + => WrapOption + -> (a -> JiraConverter m Text) + -> a + -> m Text +runDefaultConverter wrap c x = evalStateT (runReaderT (c x) wrap) startState -- | Return Jira representation of document. pandocToJira :: PandocMonad m - => WriterOptions -> Pandoc -> JiraWriter m Text + => WriterOptions -> Pandoc -> JiraConverter m Text pandocToJira opts (Pandoc meta blocks) = do + wrap <- ask metadata <- metaToContext opts - (fmap literal . blockListToJira opts) - (fmap literal . inlineListToJira opts) meta - body <- blockListToJira opts blocks + (fmap literal . runDefaultConverter wrap blockListToJira) + (fmap literal . runDefaultConverter wrap inlineListToJira) meta + body <- blockListToJira blocks notes <- gets $ T.intercalate "\n" . reverse . stNotes - let main = body <> if T.null notes - then mempty - else T.pack "\n\n" <> notes + let main = body <> if T.null notes then mempty else "\n\n" <> notes let context = defField "body" main metadata return $ case writerTemplate opts of Nothing -> main Just tpl -> render Nothing $ renderTemplate tpl context --- | Escape one character as needed for Jira. -escapeCharForJira :: Char -> Text -escapeCharForJira c = - let specialChars = "_*-+~^|!{}[]" :: String - in case c of - '\x2013' -> " -- " - '\x2014' -> " --- " - '\x2026' -> "..." - _ | c `elem` specialChars -> T.cons '\\' (T.singleton c) - _ -> T.singleton c - --- | Escape string as needed for Jira. -escapeStringForJira :: Text -> Text -escapeStringForJira = T.concatMap escapeCharForJira - --- | Create an anchor macro from the given element attributes. -anchor :: Attr -> Text -anchor (ident,_,_) = - if ident == "" - then "" - else "{anchor:" <> ident <> "}" - --- | Append a newline character unless we are in a list. -appendNewlineUnlessInList :: PandocMonad m - => Text - -> JiraWriter m Text -appendNewlineUnlessInList t = do - listLevel <- gets stListLevel - return (if T.null listLevel then t <> "\n" else t) - --- | Convert Pandoc block element to Jira. -blockToJira :: PandocMonad m - => WriterOptions -- ^ Options - -> Block -- ^ Block element - -> JiraWriter m Text - -blockToJira _ Null = return "" - -blockToJira opts (Div attr bs) = - (anchor attr <>) <$> blockListToJira opts bs - -blockToJira opts (Plain inlines) = - inlineListToJira opts inlines - -blockToJira opts (Para inlines) = do - contents <- inlineListToJira opts inlines - appendNewlineUnlessInList contents - -blockToJira opts (LineBlock lns) = - blockToJira opts $ linesToPara lns - -blockToJira _ b@(RawBlock f str) = - if f == Format "jira" - then return str - else "" <$ report (BlockNotRendered b) - -blockToJira _ HorizontalRule = return "----\n" - -blockToJira opts (Header level attr inlines) = do - contents <- inlineListToJira opts inlines - let prefix = "h" <> pack (show level) <> ". " - return $ prefix <> anchor attr <> contents <> "\n" - -blockToJira _ (CodeBlock attr@(_,classes,_) str) = do - let lang = find (\c -> T.toLower c `elem` knownLanguages) classes - let start = case lang of - Nothing -> "{code}" - Just l -> "{code:" <> l <> "}" - let anchorMacro = anchor attr - appendNewlineUnlessInList . T.intercalate "\n" $ - (if anchorMacro == "" then id else (anchorMacro :)) - [start, str, "{code}"] - -blockToJira opts (BlockQuote [p@(Para _)]) = do - contents <- blockToJira opts p - return ("bq. " <> contents) - -blockToJira opts (BlockQuote blocks) = do - contents <- blockListToJira opts blocks - appendNewlineUnlessInList . T.unlines $ - [ "{quote}", contents, "{quote}"] - -blockToJira opts (Table _caption _aligns _widths headers rows) = do - headerCells <- mapM blocksToCell headers - bodyRows <- mapM (mapM blocksToCell) rows - let tblHead = headerCellsToRow headerCells - let tblBody = map cellsToRow bodyRows - return $ if all null headers - then T.unlines tblBody - else T.unlines (tblHead : tblBody) - where - blocksToCell :: PandocMonad m => [Block] -> JiraWriter m Text - blocksToCell = inlineListToJira opts . blocksToInlines - - cellsToRow :: [Text] -> Text - cellsToRow cells = "|" <> T.intercalate "|" cells <> "|" - - headerCellsToRow :: [Text] -> Text - headerCellsToRow cells = "||" <> T.intercalate "||" cells <> "||" - -blockToJira opts (BulletList items) = - listWithMarker opts items '*' - -blockToJira opts (OrderedList _listAttr items) = - listWithMarker opts items '#' - -blockToJira opts (DefinitionList items) = - blockToJira opts (BulletList (map defToBulletItem items)) - where - defToBulletItem :: ([Inline], [[Block]]) -> [Block] - defToBulletItem (inlns, defs) = - let term = Plain [Strong inlns] - blks = mconcat defs - in term : blks - --- Auxiliary functions for lists: - --- | Create a list using the given character as bullet item marker. -listWithMarker :: PandocMonad m - => WriterOptions - -> [[Block]] - -> Char - -> JiraWriter m Text -listWithMarker opts items marker = do - modify $ \s -> s { stListLevel = stListLevel s `T.snoc` marker } - contents <- mapM (listItemToJira opts) items - modify $ \s -> s { stListLevel = T.init (stListLevel s) } - appendNewlineUnlessInList $ T.intercalate "\n" contents - --- | Convert bullet or ordered list item (list of blocks) to Jira. -listItemToJira :: PandocMonad m - => WriterOptions - -> [Block] - -> JiraWriter m Text -listItemToJira opts items = do - contents <- blockListToJira opts items - marker <- gets stListLevel - return $ marker <> " " <> contents - --- | Convert list of Pandoc block elements to Jira. -blockListToJira :: PandocMonad m - => WriterOptions -- ^ Options - -> [Block] -- ^ List of block elements - -> JiraWriter m Text -blockListToJira opts blocks = - T.intercalate "\n" <$> mapM (blockToJira opts) blocks - --- | Convert list of Pandoc inline elements to Jira. -inlineListToJira :: PandocMonad m - => WriterOptions - -> [Inline] - -> JiraWriter m Text -inlineListToJira opts lst = - T.concat <$> mapM (inlineToJira opts) lst - --- | Convert Pandoc inline element to Jira. -inlineToJira :: PandocMonad m - => WriterOptions - -> Inline - -> JiraWriter m Text - -inlineToJira opts (Span attr lst) = - (anchor attr <>) <$> inlineListToJira opts lst - -inlineToJira opts (Emph lst) = do - contents <- inlineListToJira opts lst - return $ "_" <> contents <> "_" - -inlineToJira opts (Strong lst) = do - contents <- inlineListToJira opts lst - return $ "*" <> contents <> "*" - -inlineToJira opts (Strikeout lst) = do - contents <- inlineListToJira opts lst - return $ "-" <> contents <> "-" - -inlineToJira opts (Superscript lst) = do - contents <- inlineListToJira opts lst - return $ "{^" <> contents <> "^}" - -inlineToJira opts (Subscript lst) = do - contents <- inlineListToJira opts lst - return $ "{~" <> contents <> "~}" - -inlineToJira opts (SmallCaps lst) = inlineListToJira opts lst - -inlineToJira opts (Quoted SingleQuote lst) = do - contents <- inlineListToJira opts lst - return $ "'" <> contents <> "'" - -inlineToJira opts (Quoted DoubleQuote lst) = do - contents <- inlineListToJira opts lst - return $ "\"" <> contents <> "\"" - -inlineToJira opts (Cite _ lst) = inlineListToJira opts lst - -inlineToJira _ (Code attr str) = - return (anchor attr <> "{{" <> str <> "}}") - -inlineToJira _ (Str str) = return $ escapeStringForJira str - -inlineToJira opts (Math InlineMath str) = - lift (texMathToInlines InlineMath str) >>= inlineListToJira opts - -inlineToJira opts (Math DisplayMath str) = do - mathInlines <- lift (texMathToInlines DisplayMath str) - contents <- inlineListToJira opts mathInlines - return $ "\\\\" <> contents <> "\\\\" - -inlineToJira _opts il@(RawInline f str) = - if f == Format "jira" - then return str - else "" <$ report (InlineNotRendered il) - -inlineToJira _ LineBreak = return "\n" - -inlineToJira _ SoftBreak = return " " - -inlineToJira _ Space = return " " - -inlineToJira opts (Link _attr txt (src, _title)) = do - linkText <- inlineListToJira opts txt - return $ T.concat - [ "[" - , if null txt then "" else linkText <> "|" - , src - , "]" - ] - -inlineToJira _opts (Image attr _alt (src, _title)) = - return . T.concat $ [anchor attr, "!", src, "!"] - -inlineToJira opts (Note contents) = do +blockListToJira :: PandocMonad m => [Block] -> JiraConverter m Text +blockListToJira = fmap prettyBlocks . toJiraBlocks + +inlineListToJira :: PandocMonad m => [Inline] -> JiraConverter m Text +inlineListToJira = fmap prettyInlines . toJiraInlines + +toJiraBlocks :: PandocMonad m => [Block] -> JiraConverter m [Jira.Block] +toJiraBlocks blocks = do + let convert = \case + BlockQuote bs -> singleton . Jira.BlockQuote + <$> toJiraBlocks bs -- FIXME! + BulletList items -> singleton . Jira.List Jira.CircleBullets + <$> toJiraItems items + CodeBlock attr cs -> toJiraCode attr cs + DefinitionList items -> toJiraDefinitionList items + Div attr bs -> toJiraPanel attr bs + Header lvl attr xs -> toJiraHeader lvl attr xs + HorizontalRule -> return . singleton $ Jira.HorizontalRule + LineBlock xs -> toJiraBlocks [linesToPara xs] + OrderedList _ items -> singleton . Jira.List Jira.Enumeration + <$> toJiraItems items + Para xs -> singleton . Jira.Para <$> toJiraInlines xs + Plain xs -> singleton . Jira.Para <$> toJiraInlines xs + RawBlock fmt cs -> rawBlockToJira fmt cs + Null -> return mempty + Table _ _ _ hd body -> singleton <$> do + headerRow <- if null hd + then Just <$> toRow Jira.HeaderCell hd + else pure Nothing + bodyRows <- mapM (toRow Jira.BodyCell) body + let rows = case headerRow of + Just header -> header : bodyRows + Nothing -> bodyRows + return $ Jira.Table rows + jiraBlocks <- mapM convert blocks + return $ mconcat jiraBlocks + +toRow :: PandocMonad m + => ([Jira.Block] -> Jira.Cell) + -> [TableCell] + -> JiraConverter m Jira.Row +toRow mkCell cells = Jira.Row <$> + mapM (fmap mkCell . toJiraBlocks) cells + +toJiraItems :: PandocMonad m => [[Block]] -> JiraConverter m [[Jira.Block]] +toJiraItems = mapM toJiraBlocks + +toJiraCode :: PandocMonad m + => Attr + -> Text + -> JiraConverter m [Jira.Block] +toJiraCode (ident, classes, _attribs) code = do + let lang = case find (\c -> T.toLower c `elem` knownLanguages) classes of + Nothing -> Jira.Language "java" + Just l -> Jira.Language l + let addAnchor b = if T.null ident + then b + else [Jira.Para (singleton (Jira.Anchor ident))] <> b + return . addAnchor . singleton $ Jira.Code lang mempty code + +-- | Creates a Jira definition list +toJiraDefinitionList :: PandocMonad m + => [([Inline], [[Block]])] + -> JiraConverter m [Jira.Block] +toJiraDefinitionList defItems = do + let convertDefItem (term, defs) = do + jiraTerm <- Jira.Para <$> styled Jira.Strong term + jiraDefs <- mconcat <$> mapM toJiraBlocks defs + return $ jiraTerm : jiraDefs + singleton . Jira.List Jira.CircleBullets <$> mapM convertDefItem defItems + +-- | Creates a Jira panel +toJiraPanel :: PandocMonad m + => Attr -> [Block] + -> JiraConverter m [Jira.Block] +toJiraPanel attr blocks = do + jiraBlocks <- toJiraBlocks blocks + return $ if attr == nullAttr + then jiraBlocks + else singleton (Jira.Panel [] jiraBlocks) + +-- | Creates a Jira header +toJiraHeader :: PandocMonad m + => Int -> Attr -> [Inline] + -> JiraConverter m [Jira.Block] +toJiraHeader lvl (ident, _, _) inlines = + let anchor = Jira.Anchor ident + in singleton . Jira.Header lvl . (anchor :) <$> toJiraInlines inlines + +-- | Handles raw block. Jira is included verbatim, everything else is +-- discarded. +rawBlockToJira :: PandocMonad m + => Format -> Text + -> JiraConverter m [Jira.Block] +rawBlockToJira fmt cs = do + rawInlines <- toJiraRaw fmt cs + return $ + if null rawInlines + then mempty + else singleton (Jira.Para rawInlines) + +toJiraRaw :: PandocMonad m + => Format -> Text -> JiraConverter m [Jira.Inline] +toJiraRaw fmt cs = case fmt of + Format "jira" -> return . singleton $ Jira.Str cs + _ -> return mempty + + +-- +-- Inlines +-- + +toJiraInlines :: PandocMonad m => [Inline] -> JiraConverter m [Jira.Inline] +toJiraInlines inlines = do + let convert = \case + Cite _ xs -> toJiraInlines xs + Code _ cs -> return . singleton $ + Jira.Monospaced (escapeSpecialChars cs) + Emph xs -> styled Jira.Emphasis xs + Image _ _ (src, _) -> pure . singleton $ Jira.Image [] (Jira.URL src) + LineBreak -> pure . singleton $ Jira.Linebreak + Link _ xs (tgt, _) -> singleton . flip Jira.Link (Jira.URL tgt) + <$> toJiraInlines xs + Math mtype cs -> mathToJira mtype cs + Note bs -> registerNotes bs + Quoted qt xs -> quotedToJira qt xs + RawInline fmt cs -> toJiraRaw fmt cs + SmallCaps xs -> styled Jira.Strong xs + SoftBreak -> do + preserveBreak <- asks (== WrapPreserve) + pure . singleton $ if preserveBreak + then Jira.Linebreak + else Jira.Space + Space -> pure . singleton $ Jira.Space + Span _attr xs -> toJiraInlines xs + Str s -> pure $ escapeSpecialChars s + Strikeout xs -> styled Jira.Strikeout xs + Strong xs -> styled Jira.Strong xs + Subscript xs -> styled Jira.Subscript xs + Superscript xs -> styled Jira.Superscript xs + jiraInlines <- mapM convert inlines + return $ mconcat jiraInlines + +singleton :: a -> [a] +singleton = (:[]) + +styled :: PandocMonad m + => Jira.InlineStyle -> [Inline] + -> JiraConverter m [Jira.Inline] +styled s = fmap (singleton . Jira.Styled s) . toJiraInlines + +-- | Converts a plain text value to Jira inlines, ensuring that all +-- special characters will be handled appropriately. +escapeSpecialChars :: Text -> [Jira.Inline] +escapeSpecialChars t = case plainText t of + Right xs -> xs + Left _ -> singleton $ Jira.Str t + +mathToJira :: PandocMonad m + => MathType + -> Text + -> JiraConverter m [Jira.Inline] +mathToJira mtype cs = do + mathInlines <- toJiraInlines =<< texMathToInlines mtype cs + return $ case mtype of + InlineMath -> mathInlines + DisplayMath -> Jira.Linebreak : mathInlines ++ [Jira.Linebreak] + +quotedToJira :: PandocMonad m + => QuoteType + -> [Inline] + -> JiraConverter m [Jira.Inline] +quotedToJira qtype xs = do + let quoteChar = case qtype of + DoubleQuote -> "\"" + SingleQuote -> "'" + let surroundWithQuotes = (Jira.Str quoteChar :) . (++ [Jira.Str quoteChar]) + surroundWithQuotes <$> toJiraInlines xs + +registerNotes :: PandocMonad m => [Block] -> JiraConverter m [Jira.Inline] +registerNotes contents = do curNotes <- gets stNotes let newnum = length curNotes + 1 - contents' <- blockListToJira opts contents - let thisnote = "[" <> pack (show newnum) <> "] " <> contents' <> "\n" + contents' <- blockListToJira contents + let thisnote = "\\[" <> T.pack (show newnum) <> "] " <> contents' <> "\n" modify $ \s -> s { stNotes = thisnote : curNotes } - return $ "[" <> pack (show newnum) <> "]" + return . singleton . Jira.Str $ + "[" <> T.pack (show newnum) <> "]" -- | Language codes recognized by jira knownLanguages :: [Text] -- cgit v1.2.3