@@ -1,3 +1,4 @@
1+{-# LANGUAGE LambdaCase #-}
12{-# LANGUAGE OverloadedStrings #-}
23{-# LANGUAGE NoImplicitPrelude #-}
34{- |
@@ -16,296 +17,251 @@ JIRA:
1617-}
1718module Text.Pandoc.Writers.Jira ( writeJira ) where
1819import Prelude
19−import Control.Monad.State.Strict
20+import Control.Monad.Reader (ReaderT, ask, asks, runReaderT)
21+import Control.Monad.State.Strict (StateT, evalStateT, gets, modify)
2022import Data.Foldable (find)
21−import Data.Text (Text, pack)
22−import Text.Pandoc.Class (PandocMonad, report)
23+import Data.Text (Text)
24+import Text.Jira.Parser (plainText)
25+import Text.Jira.Printer (prettyBlocks, prettyInlines)
26+import Text.Pandoc.Class (PandocMonad)
2327import Text.Pandoc.Definition
24−import Text.Pandoc.Logging (LogMessage (BlockNotRendered, InlineNotRendered))
25−import Text.Pandoc.Options (WriterOptions (writerTemplate))
26−import Text.Pandoc.Shared (blocksToInlines, linesToPara)
28+import Text.Pandoc.Options (WriterOptions (writerTemplate, writerWrapText),
29+ WrapOption (..))
30+import Text.Pandoc.Shared (linesToPara)
2731import Text.Pandoc.Templates (renderTemplate)
2832import Text.Pandoc.Writers.Math (texMathToInlines)
29−import Text.Pandoc.Writers.Shared (metaToContext, defField)
30−import qualified Data.Text as T
33+import Text.Pandoc.Writers.Shared (defField, metaToContext)
3134import Text.DocLayout (literal, render)
35+import qualified Data.Text as T
36+import qualified Text.Jira.Markup as Jira
3237
33−data WriterState = WriterState
34− { stNotes :: [Text] -- Footnotes
35− , stListLevel :: Text -- String at beginning of list items, e.g. "**"
36− }
38+-- | Convert Pandoc to Jira.
39+writeJira :: PandocMonad m => WriterOptions -> Pandoc -> m Text
40+writeJira opts = runDefaultConverter (writerWrapText opts) (pandocToJira opts)
3741
38−-- | Initial writer state
39−startState :: WriterState
40−startState = WriterState
41− { stNotes = []
42− , stListLevel = ""
43− }
42+-- | State to keep track of footnotes.
43+newtype ConverterState = ConverterState { stNotes :: [Text] }
4444
45−type JiraWriter = StateT WriterState
45+-- | Initial converter state.
46+startState :: ConverterState
47+startState = ConverterState { stNotes = [] }
4648
47−-- | Convert Pandoc to Jira.
48−writeJira :: PandocMonad m => WriterOptions -> Pandoc -> m Text
49−writeJira opts document =
50− evalStateT (pandocToJira opts document) startState
49+-- | Converter monad
50+type JiraConverter m = ReaderT WrapOption (StateT ConverterState m)
51+
52+-- | Run a converter using the default state
53+runDefaultConverter :: PandocMonad m
54+ => WrapOption
55+ -> (a -> JiraConverter m Text)
56+ -> a
57+ -> m Text
58+runDefaultConverter wrap c x = evalStateT (runReaderT (c x) wrap) startState
5159
5260-- | Return Jira representation of document.
5361pandocToJira :: PandocMonad m
54− => WriterOptions -> Pandoc -> JiraWriter m Text
62+ => WriterOptions -> Pandoc -> JiraConverter m Text
5563pandocToJira opts (Pandoc meta blocks) = do
64+ wrap <- ask
5665 metadata <- metaToContext opts
57− (fmap literal . blockListToJira opts)
58− (fmap literal . inlineListToJira opts) meta
59− body <- blockListToJira opts blocks
66+ (fmap literal . runDefaultConverter wrap blockListToJira)
67+ (fmap literal . runDefaultConverter wrap inlineListToJira) meta
68+ body <- blockListToJira blocks
6069 notes <- gets $ T.intercalate "\n" . reverse . stNotes
61− let main = body <> if T.null notes
62− then mempty
63− else T.pack "\n\n" <> notes
70+ let main = body <> if T.null notes then mempty else "\n\n" <> notes
6471 let context = defField "body" main metadata
6572 return $
6673 case writerTemplate opts of
6774 Nothing -> main
6875 Just tpl -> render Nothing $ renderTemplate tpl context
6976
70−-- | Escape one character as needed for Jira.
71−escapeCharForJira :: Char -> Text
72−escapeCharForJira c =
73− let specialChars = "_*-+~^|!{}[]" :: String
74− in case c of
75− '\x2013' -> " -- "
76− '\x2014' -> " --- "
77− '\x2026' -> "..."
78− _ | c `elem` specialChars -> T.cons '\\' (T.singleton c)
79− _ -> T.singleton c
80−
81−-- | Escape string as needed for Jira.
82−escapeStringForJira :: Text -> Text
83−escapeStringForJira = T.concatMap escapeCharForJira
84−
85−-- | Create an anchor macro from the given element attributes.
86−anchor :: Attr -> Text
87−anchor (ident,_,_) =
88− if ident == ""
89− then ""
90− else "{anchor:" <> ident <> "}"
91−
92−-- | Append a newline character unless we are in a list.
93−appendNewlineUnlessInList :: PandocMonad m
94− => Text
95− -> JiraWriter m Text
96−appendNewlineUnlessInList t = do
97− listLevel <- gets stListLevel
98− return (if T.null listLevel then t <> "\n" else t)
99−
100−-- | Convert Pandoc block element to Jira.
101−blockToJira :: PandocMonad m
102− => WriterOptions -- ^ Options
103− -> Block -- ^ Block element
104− -> JiraWriter m Text
105−
106−blockToJira _ Null = return ""
107−
108−blockToJira opts (Div attr bs) =
109− (anchor attr <>) <$> blockListToJira opts bs
110−
111−blockToJira opts (Plain inlines) =
112− inlineListToJira opts inlines
113−
114−blockToJira opts (Para inlines) = do
115− contents <- inlineListToJira opts inlines
116− appendNewlineUnlessInList contents
117−
118−blockToJira opts (LineBlock lns) =
119− blockToJira opts $ linesToPara lns
120−
121−blockToJira _ b@(RawBlock f str) =
122− if f == Format "jira"
123− then return str
124− else "" <$ report (BlockNotRendered b)
125−
126−blockToJira _ HorizontalRule = return "----\n"
127−
128−blockToJira opts (Header level attr inlines) = do
129− contents <- inlineListToJira opts inlines
130− let prefix = "h" <> pack (show level) <> ". "
131− return $ prefix <> anchor attr <> contents <> "\n"
132−
133−blockToJira _ (CodeBlock attr@(_,classes,_) str) = do
134− let lang = find (\c -> T.toLower c `elem` knownLanguages) classes
135− let start = case lang of
136− Nothing -> "{code}"
137− Just l -> "{code:" <> l <> "}"
138− let anchorMacro = anchor attr
139− appendNewlineUnlessInList . T.intercalate "\n" $
140− (if anchorMacro == "" then id else (anchorMacro :))
141− [start, str, "{code}"]
142−
143−blockToJira opts (BlockQuote [p@(Para _)]) = do
144− contents <- blockToJira opts p
145− return ("bq. " <> contents)
146−
147−blockToJira opts (BlockQuote blocks) = do
148− contents <- blockListToJira opts blocks
149− appendNewlineUnlessInList . T.unlines $
150− [ "{quote}", contents, "{quote}"]
151−
152−blockToJira opts (Table _caption _aligns _widths headers rows) = do
153− headerCells <- mapM blocksToCell headers
154− bodyRows <- mapM (mapM blocksToCell) rows
155− let tblHead = headerCellsToRow headerCells
156− let tblBody = map cellsToRow bodyRows
157− return $ if all null headers
158− then T.unlines tblBody
159− else T.unlines (tblHead : tblBody)
160− where
161− blocksToCell :: PandocMonad m => [Block] -> JiraWriter m Text
162− blocksToCell = inlineListToJira opts . blocksToInlines
163−
164− cellsToRow :: [Text] -> Text
165− cellsToRow cells = "|" <> T.intercalate "|" cells <> "|"
166−
167− headerCellsToRow :: [Text] -> Text
168− headerCellsToRow cells = "||" <> T.intercalate "||" cells <> "||"
169−
170−blockToJira opts (BulletList items) =
171− listWithMarker opts items '*'
172−
173−blockToJira opts (OrderedList _listAttr items) =
174− listWithMarker opts items '#'
175−
176−blockToJira opts (DefinitionList items) =
177− blockToJira opts (BulletList (map defToBulletItem items))
178− where
179− defToBulletItem :: ([Inline], [[Block]]) -> [Block]
180− defToBulletItem (inlns, defs) =
181− let term = Plain [Strong inlns]
182− blks = mconcat defs
183− in term : blks
184−
185−-- Auxiliary functions for lists:
186−
187−-- | Create a list using the given character as bullet item marker.
188−listWithMarker :: PandocMonad m
189− => WriterOptions
190− -> [[Block]]
191− -> Char
192− -> JiraWriter m Text
193−listWithMarker opts items marker = do
194− modify $ \s -> s { stListLevel = stListLevel s `T.snoc` marker }
195− contents <- mapM (listItemToJira opts) items
196− modify $ \s -> s { stListLevel = T.init (stListLevel s) }
197− appendNewlineUnlessInList $ T.intercalate "\n" contents
198−
199−-- | Convert bullet or ordered list item (list of blocks) to Jira.
200−listItemToJira :: PandocMonad m
201− => WriterOptions
202− -> [Block]
203− -> JiraWriter m Text
204−listItemToJira opts items = do
205− contents <- blockListToJira opts items
206− marker <- gets stListLevel
207− return $ marker <> " " <> contents
208−
209−-- | Convert list of Pandoc block elements to Jira.
210−blockListToJira :: PandocMonad m
211− => WriterOptions -- ^ Options
212− -> [Block] -- ^ List of block elements
213− -> JiraWriter m Text
214−blockListToJira opts blocks =
215− T.intercalate "\n" <$> mapM (blockToJira opts) blocks
216−
217−-- | Convert list of Pandoc inline elements to Jira.
218−inlineListToJira :: PandocMonad m
219− => WriterOptions
220− -> [Inline]
221− -> JiraWriter m Text
222−inlineListToJira opts lst =
223− T.concat <$> mapM (inlineToJira opts) lst
224−
225−-- | Convert Pandoc inline element to Jira.
226−inlineToJira :: PandocMonad m
227− => WriterOptions
228− -> Inline
229− -> JiraWriter m Text
230−
231−inlineToJira opts (Span attr lst) =
232− (anchor attr <>) <$> inlineListToJira opts lst
233−
234−inlineToJira opts (Emph lst) = do
235− contents <- inlineListToJira opts lst
236− return $ "_" <> contents <> "_"
237−
238−inlineToJira opts (Strong lst) = do
239− contents <- inlineListToJira opts lst
240− return $ "*" <> contents <> "*"
241−
242−inlineToJira opts (Strikeout lst) = do
243− contents <- inlineListToJira opts lst
244− return $ "-" <> contents <> "-"
245−
246−inlineToJira opts (Superscript lst) = do
247− contents <- inlineListToJira opts lst
248− return $ "{^" <> contents <> "^}"
249−
250−inlineToJira opts (Subscript lst) = do
251− contents <- inlineListToJira opts lst
252− return $ "{~" <> contents <> "~}"
253−
254−inlineToJira opts (SmallCaps lst) = inlineListToJira opts lst
255−
256−inlineToJira opts (Quoted SingleQuote lst) = do
257− contents <- inlineListToJira opts lst
258− return $ "'" <> contents <> "'"
259−
260−inlineToJira opts (Quoted DoubleQuote lst) = do
261− contents <- inlineListToJira opts lst
262− return $ "\"" <> contents <> "\""
263−
264−inlineToJira opts (Cite _ lst) = inlineListToJira opts lst
265−
266−inlineToJira _ (Code attr str) =
267− return (anchor attr <> "{{" <> str <> "}}")
268−
269−inlineToJira _ (Str str) = return $ escapeStringForJira str
270−
271−inlineToJira opts (Math InlineMath str) =
272− lift (texMathToInlines InlineMath str) >>= inlineListToJira opts
273−
274−inlineToJira opts (Math DisplayMath str) = do
275− mathInlines <- lift (texMathToInlines DisplayMath str)
276− contents <- inlineListToJira opts mathInlines
277− return $ "\\\\" <> contents <> "\\\\"
278−
279−inlineToJira _opts il@(RawInline f str) =
280− if f == Format "jira"
281− then return str
282− else "" <$ report (InlineNotRendered il)
283−
284−inlineToJira _ LineBreak = return "\n"
285−
286−inlineToJira _ SoftBreak = return " "
287−
288−inlineToJira _ Space = return " "
289−
290−inlineToJira opts (Link _attr txt (src, _title)) = do
291− linkText <- inlineListToJira opts txt
292− return $ T.concat
293− [ "["
294− , if null txt then "" else linkText <> "|"
295− , src
296− , "]"
297− ]
298−
299−inlineToJira _opts (Image attr _alt (src, _title)) =
300− return . T.concat $ [anchor attr, "!", src, "!"]
301−
302−inlineToJira opts (Note contents) = do
77+blockListToJira :: PandocMonad m => [Block] -> JiraConverter m Text
78+blockListToJira = fmap prettyBlocks . toJiraBlocks
79+
80+inlineListToJira :: PandocMonad m => [Inline] -> JiraConverter m Text
81+inlineListToJira = fmap prettyInlines . toJiraInlines
82+
83+toJiraBlocks :: PandocMonad m => [Block] -> JiraConverter m [Jira.Block]
84+toJiraBlocks blocks = do
85+ let convert = \case
86+ BlockQuote bs -> singleton . Jira.BlockQuote
87+ <$> toJiraBlocks bs -- FIXME!
88+ BulletList items -> singleton . Jira.List Jira.CircleBullets
89+ <$> toJiraItems items
90+ CodeBlock attr cs -> toJiraCode attr cs
91+ DefinitionList items -> toJiraDefinitionList items
92+ Div attr bs -> toJiraPanel attr bs
93+ Header lvl attr xs -> toJiraHeader lvl attr xs
94+ HorizontalRule -> return . singleton $ Jira.HorizontalRule
95+ LineBlock xs -> toJiraBlocks [linesToPara xs]
96+ OrderedList _ items -> singleton . Jira.List Jira.Enumeration
97+ <$> toJiraItems items
98+ Para xs -> singleton . Jira.Para <$> toJiraInlines xs
99+ Plain xs -> singleton . Jira.Para <$> toJiraInlines xs
100+ RawBlock fmt cs -> rawBlockToJira fmt cs
101+ Null -> return mempty
102+ Table _ _ _ hd body -> singleton <$> do
103+ headerRow <- if null hd
104+ then Just <$> toRow Jira.HeaderCell hd
105+ else pure Nothing
106+ bodyRows <- mapM (toRow Jira.BodyCell) body
107+ let rows = case headerRow of
108+ Just header -> header : bodyRows
109+ Nothing -> bodyRows
110+ return $ Jira.Table rows
111+ jiraBlocks <- mapM convert blocks
112+ return $ mconcat jiraBlocks
113+
114+toRow :: PandocMonad m
115+ => ([Jira.Block] -> Jira.Cell)
116+ -> [TableCell]
117+ -> JiraConverter m Jira.Row
118+toRow mkCell cells = Jira.Row <$>
119+ mapM (fmap mkCell . toJiraBlocks) cells
120+
121+toJiraItems :: PandocMonad m => [[Block]] -> JiraConverter m [[Jira.Block]]
122+toJiraItems = mapM toJiraBlocks
123+
124+toJiraCode :: PandocMonad m
125+ => Attr
126+ -> Text
127+ -> JiraConverter m [Jira.Block]
128+toJiraCode (ident, classes, _attribs) code = do
129+ let lang = case find (\c -> T.toLower c `elem` knownLanguages) classes of
130+ Nothing -> Jira.Language "java"
131+ Just l -> Jira.Language l
132+ let addAnchor b = if T.null ident
133+ then b
134+ else [Jira.Para (singleton (Jira.Anchor ident))] <> b
135+ return . addAnchor . singleton $ Jira.Code lang mempty code
136+
137+-- | Creates a Jira definition list
138+toJiraDefinitionList :: PandocMonad m
139+ => [([Inline], [[Block]])]
140+ -> JiraConverter m [Jira.Block]
141+toJiraDefinitionList defItems = do
142+ let convertDefItem (term, defs) = do
143+ jiraTerm <- Jira.Para <$> styled Jira.Strong term
144+ jiraDefs <- mconcat <$> mapM toJiraBlocks defs
145+ return $ jiraTerm : jiraDefs
146+ singleton . Jira.List Jira.CircleBullets <$> mapM convertDefItem defItems
147+
148+-- | Creates a Jira panel
149+toJiraPanel :: PandocMonad m
150+ => Attr -> [Block]
151+ -> JiraConverter m [Jira.Block]
152+toJiraPanel attr blocks = do
153+ jiraBlocks <- toJiraBlocks blocks
154+ return $ if attr == nullAttr
155+ then jiraBlocks
156+ else singleton (Jira.Panel [] jiraBlocks)
157+
158+-- | Creates a Jira header
159+toJiraHeader :: PandocMonad m
160+ => Int -> Attr -> [Inline]
161+ -> JiraConverter m [Jira.Block]
162+toJiraHeader lvl (ident, _, _) inlines =
163+ let anchor = Jira.Anchor ident
164+ in singleton . Jira.Header lvl . (anchor :) <$> toJiraInlines inlines
165+
166+-- | Handles raw block. Jira is included verbatim, everything else is
167+-- discarded.
168+rawBlockToJira :: PandocMonad m
169+ => Format -> Text
170+ -> JiraConverter m [Jira.Block]
171+rawBlockToJira fmt cs = do
172+ rawInlines <- toJiraRaw fmt cs
173+ return $
174+ if null rawInlines
175+ then mempty
176+ else singleton (Jira.Para rawInlines)
177+
178+toJiraRaw :: PandocMonad m
179+ => Format -> Text -> JiraConverter m [Jira.Inline]
180+toJiraRaw fmt cs = case fmt of
181+ Format "jira" -> return . singleton $ Jira.Str cs
182+ _ -> return mempty
183+
184+
185+--
186+-- Inlines
187+--
188+
189+toJiraInlines :: PandocMonad m => [Inline] -> JiraConverter m [Jira.Inline]
190+toJiraInlines inlines = do
191+ let convert = \case
192+ Cite _ xs -> toJiraInlines xs
193+ Code _ cs -> return . singleton $
194+ Jira.Monospaced (escapeSpecialChars cs)
195+ Emph xs -> styled Jira.Emphasis xs
196+ Image _ _ (src, _) -> pure . singleton $ Jira.Image [] (Jira.URL src)
197+ LineBreak -> pure . singleton $ Jira.Linebreak
198+ Link _ xs (tgt, _) -> singleton . flip Jira.Link (Jira.URL tgt)
199+ <$> toJiraInlines xs
200+ Math mtype cs -> mathToJira mtype cs
201+ Note bs -> registerNotes bs
202+ Quoted qt xs -> quotedToJira qt xs
203+ RawInline fmt cs -> toJiraRaw fmt cs
204+ SmallCaps xs -> styled Jira.Strong xs
205+ SoftBreak -> do
206+ preserveBreak <- asks (== WrapPreserve)
207+ pure . singleton $ if preserveBreak
208+ then Jira.Linebreak
209+ else Jira.Space
210+ Space -> pure . singleton $ Jira.Space
211+ Span _attr xs -> toJiraInlines xs
212+ Str s -> pure $ escapeSpecialChars s
213+ Strikeout xs -> styled Jira.Strikeout xs
214+ Strong xs -> styled Jira.Strong xs
215+ Subscript xs -> styled Jira.Subscript xs
216+ Superscript xs -> styled Jira.Superscript xs
217+ jiraInlines <- mapM convert inlines
218+ return $ mconcat jiraInlines
219+
220+singleton :: a -> [a]
221+singleton = (:[])
222+
223+styled :: PandocMonad m
224+ => Jira.InlineStyle -> [Inline]
225+ -> JiraConverter m [Jira.Inline]
226+styled s = fmap (singleton . Jira.Styled s) . toJiraInlines
227+
228+-- | Converts a plain text value to Jira inlines, ensuring that all
229+-- special characters will be handled appropriately.
230+escapeSpecialChars :: Text -> [Jira.Inline]
231+escapeSpecialChars t = case plainText t of
232+ Right xs -> xs
233+ Left _ -> singleton $ Jira.Str t
234+
235+mathToJira :: PandocMonad m
236+ => MathType
237+ -> Text
238+ -> JiraConverter m [Jira.Inline]
239+mathToJira mtype cs = do
240+ mathInlines <- toJiraInlines =<< texMathToInlines mtype cs
241+ return $ case mtype of
242+ InlineMath -> mathInlines
243+ DisplayMath -> Jira.Linebreak : mathInlines ++ [Jira.Linebreak]
244+
245+quotedToJira :: PandocMonad m
246+ => QuoteType
247+ -> [Inline]
248+ -> JiraConverter m [Jira.Inline]
249+quotedToJira qtype xs = do
250+ let quoteChar = case qtype of
251+ DoubleQuote -> "\""
252+ SingleQuote -> "'"
253+ let surroundWithQuotes = (Jira.Str quoteChar :) . (++ [Jira.Str quoteChar])
254+ surroundWithQuotes <$> toJiraInlines xs
255+
256+registerNotes :: PandocMonad m => [Block] -> JiraConverter m [Jira.Inline]
257+registerNotes contents = do
303258 curNotes <- gets stNotes
304259 let newnum = length curNotes + 1
305− contents' <- blockListToJira opts contents
306− let thisnote = "[" <> pack (show newnum) <> "] " <> contents' <> "\n"
260+ contents' <- blockListToJira contents
261+ let thisnote = "\\[" <> T.pack (show newnum) <> "] " <> contents' <> "\n"
307262 modify $ \s -> s { stNotes = thisnote : curNotes }
308− return $ "[" <> pack (show newnum) <> "]"
263+ return . singleton . Jira.Str $
264+ "[" <> T.pack (show newnum) <> "]"
309265
310266-- | Language codes recognized by jira
311267knownLanguages :: [Text]