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
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Readers.Org
Copyright : © 2019-2020 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Conversion of jira wiki formatted plain text to 'Pandoc' document.
-}
module Text.Pandoc.Readers.Jira ( readJira ) where
import Control.Monad.Except (throwError)
import Data.Text (Text, append, pack, singleton, unpack)
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Jira.Parser (parse)
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.Builder hiding (cell)
import Text.Pandoc.Error (PandocError (PandocParseError))
import Text.Pandoc.Options (ReaderOptions)
import Text.Pandoc.Shared (stringify)
import qualified Text.Jira.Markup as Jira
-- | Read Jira wiki markup.
readJira :: PandocMonad m
=> ReaderOptions
-> Text
-> m Pandoc
readJira _opts s = case parse s of
Right d -> return $ jiraToPandoc d
Left e -> throwError . PandocParseError $
"Jira parse error" `append` pack (show e)
jiraToPandoc :: Jira.Doc -> Pandoc
jiraToPandoc (Jira.Doc blks) = doc $ foldMap jiraToPandocBlocks blks
--
-- Blocks
--
-- | Converts a Jira block to a Pandoc block.
jiraToPandocBlocks :: Jira.Block -> Blocks
jiraToPandocBlocks = \case
Jira.BlockQuote blcks -> blockQuote $ foldMap jiraToPandocBlocks blcks
Jira.Code lang ps txt -> toPandocCodeBlocks (Just lang) ps txt
Jira.Color c blcks -> divWith (mempty, mempty, [("color", colorName c)]) $
foldMap jiraToPandocBlocks blcks
Jira.Header lvl inlns -> header lvl $ foldMap jiraToPandocInlines inlns
Jira.HorizontalRule -> horizontalRule
Jira.List style items -> toPandocList style items
Jira.NoFormat ps txt -> toPandocCodeBlocks Nothing ps txt
Jira.Panel ps blcks -> toPandocDiv ps blcks
Jira.Para inlns -> para $ foldMap jiraToPandocInlines inlns
Jira.Table rows -> toPandocTable rows
-- | Create a pandoc list – either to a @'BulletList'@ or an @'OrderedList'@.
toPandocList :: Jira.ListStyle -> [[Jira.Block]] -> Blocks
toPandocList style items =
let items' = map (foldMap jiraToPandocBlocks) items
in if style == Jira.Enumeration
then orderedList items'
else bulletList items'
-- | Create a pandoc @'CodeBlock'@
toPandocCodeBlocks :: Maybe Jira.Language -> [Jira.Parameter] -> Text -> Blocks
toPandocCodeBlocks langMay params txt =
let classes = case langMay of
Just (Jira.Language lang) -> [lang]
Nothing -> []
in codeBlockWith ("", classes, map paramToPair params) txt
-- | Create a pandoc @'Div'@
toPandocDiv :: [Jira.Parameter] -> [Jira.Block] -> Blocks
toPandocDiv params =
divWith ("", [], map paramToPair params) . foldMap jiraToPandocBlocks
paramToPair :: Jira.Parameter -> (Text, Text)
paramToPair (Jira.Parameter key value) = (key, value)
-- | Give textual representation of a color.
colorName :: Jira.ColorName -> Text
colorName (Jira.ColorName name) = name
-- | Create a pandoc @'Table'@.
-- This relies on 'simpleTable' to sanitize the table.
toPandocTable :: [Jira.Row] -> Blocks
toPandocTable rows =
let (headerRow, bodyRows) = splitIntoHeaderAndBody rows
in simpleTable
(rowToBlocksList headerRow)
(map rowToBlocksList bodyRows)
rowToBlocksList :: Jira.Row -> [Blocks]
rowToBlocksList (Jira.Row cells) =
map cellContent cells
where
cellContent cell = let content = case cell of
Jira.HeaderCell x -> x
Jira.BodyCell x -> x
in foldMap jiraToPandocBlocks content
splitIntoHeaderAndBody :: [Jira.Row] -> (Jira.Row, [Jira.Row])
splitIntoHeaderAndBody [] = (Jira.Row [], [])
splitIntoHeaderAndBody rows@(first@(Jira.Row cells) : rest) =
let isHeaderCell Jira.HeaderCell{} = True
isHeaderCell Jira.BodyCell{} = False
in if all isHeaderCell cells
then (first, rest)
else (Jira.Row [], rows)
--
-- Inlines
--
-- | Converts a Jira inline to a Pandoc block.
jiraToPandocInlines :: Jira.Inline -> Inlines
jiraToPandocInlines = \case
Jira.Anchor t -> spanWith (t, [], []) mempty
Jira.AutoLink url -> link (Jira.fromURL url) "" (str (Jira.fromURL url))
Jira.Citation ils -> str "—" <> space <> emph (fromInlines ils)
Jira.ColorInline c ils -> spanWith ("", [], [("color", colorName c)]) $
fromInlines ils
Jira.Emoji icon -> str . iconUnicode $ icon
Jira.Entity entity -> str . fromEntity $ entity
Jira.Image params url -> let (title, attr) = imgParams params
in imageWith attr (Jira.fromURL url) title mempty
Jira.Link lt alias url -> jiraLinkToPandoc lt alias url
Jira.Linebreak -> linebreak
Jira.Monospaced inlns -> code . stringify . toList . fromInlines $ inlns
Jira.Space -> space
Jira.SpecialChar c -> str (Data.Text.singleton c)
Jira.Str t -> str t
Jira.Styled style inlns -> fromStyle style $ fromInlines inlns
where
fromInlines = foldMap jiraToPandocInlines
fromEntity e = case lookupEntity (unpack e ++ ";") of
Nothing -> "&" `append` e `append` ";"
Just cs -> pack cs
fromStyle = \case
Jira.Emphasis -> emph
Jira.Insert -> underline
Jira.Strikeout -> strikeout
Jira.Strong -> strong
Jira.Subscript -> subscript
Jira.Superscript -> superscript
imgParams :: [Jira.Parameter] -> (Text, Attr)
imgParams = foldr addImgParam ("", ("", [], []))
addImgParam :: Jira.Parameter -> (Text, Attr) -> (Text, Attr)
addImgParam p (title, attr@(ident, classes, kvs)) =
case Jira.parameterKey p of
"title" -> (Jira.parameterValue p, attr)
"thumbnail" -> (title, (ident, "thumbnail":classes, kvs))
_ -> let kv = (Jira.parameterKey p, Jira.parameterValue p)
in (title, (ident, classes, kv:kvs))
-- | Convert a Jira link to pandoc inlines.
jiraLinkToPandoc :: Jira.LinkType -> [Jira.Inline] -> Jira.URL -> Inlines
jiraLinkToPandoc linkType alias url =
let url' = (if linkType == Jira.User then ("~" <>) else id) $ Jira.fromURL url
alias' = case alias of
[] -> str url'
_ -> foldMap jiraToPandocInlines alias
in case linkType of
Jira.External -> link url' "" alias'
Jira.Email -> link ("mailto:" <> url') "" alias'
Jira.Attachment -> linkWith ("", ["attachment"], []) url' "" alias'
Jira.User -> linkWith ("", ["user-account"], []) url' "" alias'
-- | Get unicode representation of a Jira icon.
iconUnicode :: Jira.Icon -> Text
iconUnicode = \case
Jira.IconSlightlySmiling -> "🙂"
Jira.IconFrowning -> "🙁"
Jira.IconTongue -> "😛"
Jira.IconSmiling -> "😃"
Jira.IconWinking -> "😉"
Jira.IconThumbsUp -> "👍"
Jira.IconThumbsDown -> "👎"
Jira.IconInfo -> "ℹ"
Jira.IconCheckmark -> "✔"
Jira.IconX -> "❌"
Jira.IconAttention -> "❗"
Jira.IconPlus -> "➕"
Jira.IconMinus -> "➖"
Jira.IconQuestionmark -> "❓"
Jira.IconOn -> "💡"
Jira.IconOff -> "🌙"
Jira.IconStar -> "⭐"
Jira.IconStarRed -> "⭐"
Jira.IconStarGreen -> "⭐"
Jira.IconStarBlue -> "⭐"
Jira.IconStarYellow -> "⭐"
Jira.IconFlag -> "⚑"
Jira.IconFlagOff -> "⚐"
|
