aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers/Jira.hs
blob: d6fa688e33b82a93da1c794a649484a7fdd39c04 (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
{-# 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
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.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 alias url    -> link (Jira.fromURL url) "" (fromInlines alias)
  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      -> spanWith ("", ["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))

-- | 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         -> "⚐"