aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Writers.hs3
-rw-r--r--src/Text/Pandoc/Writers/Jira.hs322
2 files changed, 325 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Writers.hs b/src/Text/Pandoc/Writers.hs
index d93128731..ecf45839e 100644
--- a/src/Text/Pandoc/Writers.hs
+++ b/src/Text/Pandoc/Writers.hs
@@ -41,6 +41,7 @@ module Text.Pandoc.Writers
, writeICML
, writeJATS
, writeJSON
+ , writeJira
, writeLaTeX
, writeMan
, writeMarkdown
@@ -91,6 +92,7 @@ import Text.Pandoc.Writers.Haddock
import Text.Pandoc.Writers.HTML
import Text.Pandoc.Writers.ICML
import Text.Pandoc.Writers.JATS
+import Text.Pandoc.Writers.Jira
import Text.Pandoc.Writers.LaTeX
import Text.Pandoc.Writers.Man
import Text.Pandoc.Writers.Markdown
@@ -141,6 +143,7 @@ writers = [
,("docbook4" , TextWriter writeDocbook4)
,("docbook5" , TextWriter writeDocbook5)
,("jats" , TextWriter writeJATS)
+ ,("jira" , TextWriter writeJira)
,("opml" , TextWriter writeOPML)
,("opendocument" , TextWriter writeOpenDocument)
,("latex" , TextWriter writeLaTeX)
diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs
new file mode 100644
index 000000000..08e5c8e40
--- /dev/null
+++ b/src/Text/Pandoc/Writers/Jira.hs
@@ -0,0 +1,322 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{- |
+ Module : Text.Pandoc.Writers.Jira
+ Copyright : © 2010-2019 Albert Krewinkel, John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' documents to Jira markup.
+
+JIRA:
+<https://jira.atlassian.com/secure/WikiRendererHelpAction.jspa?section=all>
+-}
+module Text.Pandoc.Writers.Jira ( writeJira ) where
+import Prelude
+import Control.Monad.State.Strict
+import Data.Char (toLower)
+import Data.Foldable (find)
+import Data.Text (Text, pack)
+import Text.Pandoc.Class (PandocMonad, report)
+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.Templates (renderTemplate')
+import Text.Pandoc.Writers.Math (texMathToInlines)
+import Text.Pandoc.Writers.Shared (metaToJSON, defField)
+import qualified Data.Text as T
+
+data WriterState = WriterState
+ { stNotes :: [Text] -- Footnotes
+ , stListLevel :: Text -- String at beginning of list items, e.g. "**"
+ }
+
+-- | Initial writer state
+startState :: WriterState
+startState = WriterState
+ { stNotes = []
+ , stListLevel = ""
+ }
+
+type JiraWriter = StateT WriterState
+
+-- | Convert Pandoc to Jira.
+writeJira :: PandocMonad m => WriterOptions -> Pandoc -> m Text
+writeJira opts document =
+ evalStateT (pandocToJira opts document) startState
+
+-- | Return Jira representation of document.
+pandocToJira :: PandocMonad m
+ => WriterOptions -> Pandoc -> JiraWriter m Text
+pandocToJira opts (Pandoc meta blocks) = do
+ metadata <- metaToJSON opts (blockListToJira opts)
+ (inlineListToJira opts) meta
+ body <- blockListToJira opts blocks
+ notes <- gets $ T.intercalate "\n" . reverse . stNotes
+ let main = body <> if T.null notes then "" else "\n\n" <> notes
+ let context = defField "body" main metadata
+ case writerTemplate opts of
+ Nothing -> return main
+ Just tpl -> renderTemplate' tpl context
+
+-- | Escape one character as needed for Jira.
+escapeCharForJira :: Char -> Text
+escapeCharForJira c = case c of
+ '&' -> "&amp;"
+ '<' -> "&lt;"
+ '>' -> "&gt;"
+ '"' -> "&quot;"
+ '*' -> "&ast;"
+ '_' -> "&lowbar;"
+ '@' -> "&commat;"
+ '+' -> "&plus;"
+ '-' -> "&hyphen;"
+ '|' -> "&vert;"
+ '{' -> "\\{"
+ '\x2014' -> " -- "
+ '\x2013' -> " - "
+ '\x2019' -> "'"
+ '\x2026' -> "..."
+ _ -> 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:" <> pack 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 (pack 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 -> map toLower c `elem` knownLanguages) classes
+ let start = case lang of
+ Nothing -> "{code}"
+ Just l -> "{code:" <> pack l <> "}"
+ let anchorMacro = anchor attr
+ appendNewlineUnlessInList . T.intercalate "\n" $
+ (if anchorMacro == "" then id else (anchorMacro :))
+ [start, escapeStringForJira (pack str), "{code}"]
+
+blockToJira opts (BlockQuote [p@(Para _)]) = do
+ contents <- blockToJira opts p
+ appendNewlineUnlessInList ("bq. " <> contents)
+
+blockToJira opts (BlockQuote blocks) = do
+ contents <- blockListToJira opts blocks
+ appendNewlineUnlessInList . T.intercalate "\n" $
+ [ "{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 <> "{{" <> escapeStringForJira (pack str) <> "}}")
+
+inlineToJira _ (Str str) = return $ escapeStringForJira (pack 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 (pack 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 <> "|"
+ , pack src
+ , "]"
+ ]
+
+inlineToJira _opts (Image attr _alt (src, _title)) =
+ return . T.concat $ [anchor attr, "!", pack src, "!"]
+
+inlineToJira opts (Note contents) = do
+ curNotes <- gets stNotes
+ let newnum = length curNotes + 1
+ contents' <- blockListToJira opts contents
+ let thisnote = "[" <> pack (show newnum) <> "] " <> contents' <> "\n"
+ modify $ \s -> s { stNotes = thisnote : curNotes }
+ return $ "[" <> pack (show newnum) <> "]"
+
+-- | Language codes recognized by jira
+knownLanguages :: [String]
+knownLanguages =
+ [ "actionscript", "ada", "applescript", "bash", "c", "c#", "c++"
+ , "css", "erlang", "go", "groovy", "haskell", "html", "javascript"
+ , "json", "lua", "nyan", "objc", "perl", "php", "python", "r", "ruby"
+ , "scala", "sql", "swift", "visualbasic", "xml", "yaml"
+ ]