aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/Jira.hs
blob: 1bf14c6a09591ef5e1741883901a52696a31d867 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{- |
   Module      : Text.Pandoc.Writers.Jira
   Copyright   : © 2010-2020 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 Control.Monad.Reader (ReaderT, ask, asks, runReaderT)
import Control.Monad.State.Strict (StateT, evalStateT, gets, modify)
import Data.Foldable (find)
import Data.Text (Text)
import Text.Jira.Parser (plainText)
import Text.Jira.Printer (prettyBlocks, prettyInlines)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions (writerTemplate, writerWrapText),
                            WrapOption (..))
import Text.Pandoc.Shared (linesToPara, stringify)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math (texMathToInlines)
import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)
import Text.DocLayout (literal, render)
import qualified Data.Text as T
import qualified Text.Jira.Markup as Jira

-- | Convert Pandoc to Jira.
writeJira :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJira opts = runDefaultConverter (writerWrapText opts) (pandocToJira opts)

-- | State to keep track of footnotes.
newtype ConverterState = ConverterState { stNotes :: [Text] }

-- | Initial converter state.
startState :: ConverterState
startState = ConverterState { stNotes = [] }

-- | 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 -> JiraConverter m Text
pandocToJira opts (Pandoc meta blocks) = do
  wrap <- ask
  metadata <- metaToContext opts
                 (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 "\n\n" <> notes
  let context = defField "body" main metadata
  return $
    case writerTemplate opts of
      Nothing  -> main
      Just tpl -> render Nothing $ renderTemplate tpl context

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
        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 _ blkCapt specs thead tbody tfoot -> singleton <$> do
          let (_, _, _, hd, body) = toLegacyTable blkCapt specs thead tbody tfoot
          headerRow <- if all null hd
                       then pure Nothing
                       else Just <$> toRow Jira.HeaderCell hd
          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)
      -> [[Block]]
      -> 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 attr _ tgt   -> imageToJira attr (fst tgt) (snd tgt)
        LineBreak          -> pure . singleton $ Jira.Linebreak
        Link attr xs tgt   -> toJiraLink attr tgt 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       -> spanToJira attr 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

imageToJira :: PandocMonad m
            => Attr -> Text -> Text
            -> JiraConverter m [Jira.Inline]
imageToJira (_, classes, kvs) src title =
  let imgParams = if "thumbnail" `elem` classes
                  then [Jira.Parameter "thumbnail" ""]
                  else map (uncurry Jira.Parameter) kvs
      imgParams' = if T.null title
                   then imgParams
                   else Jira.Parameter "title" title : imgParams
  in pure . singleton $ Jira.Image imgParams' (Jira.URL src)

-- | Creates a Jira Link element.
toJiraLink :: PandocMonad m
           => Attr
           -> Target
           -> [Inline]
           -> JiraConverter m [Jira.Inline]
toJiraLink (_, classes, _) (url, _) alias = do
  let (linkType, url') = toLinkType url
  description <- if url `elem` [stringify alias, "mailto:" <> stringify alias]
                 then pure mempty
                 else toJiraInlines alias
  pure . singleton $ Jira.Link linkType description (Jira.URL url')
 where
  toLinkType url'
    | Just email <- T.stripPrefix "mailto:" url' = (Jira.Email, email)
    | "user-account" `elem` classes              = (Jira.User, dropTilde url)
    | "attachment" `elem` classes                = (Jira.Attachment, url)
    | otherwise                                  = (Jira.External, url)
  dropTilde txt = case T.uncons txt of
    Just ('~', username) -> username
    _                    -> txt

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

spanToJira :: PandocMonad m
           => Attr -> [Inline]
           -> JiraConverter m [Jira.Inline]
spanToJira (_, classes, _) =
  if "underline" `elem` classes
  then styled Jira.Insert
  else toJiraInlines

registerNotes :: PandocMonad m => [Block] -> JiraConverter m [Jira.Inline]
registerNotes contents = do
  curNotes <- gets stNotes
  let newnum = length curNotes + 1
  contents' <- blockListToJira contents
  let thisnote = "\\[" <> T.pack (show newnum) <> "] " <> contents' <> "\n"
  modify $ \s -> s { stNotes = thisnote : curNotes }
  return . singleton . Jira.Str $
    "[" <> T.pack (show newnum) <> "]"

-- | Language codes recognized by jira
knownLanguages :: [Text]
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"
  ]