{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.Org
   Copyright   : © 2019-2021 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 :: ReaderOptions -> Text -> m Pandoc
readJira ReaderOptions
_opts Text
s = case Text -> Either ParseError Doc
parse Text
s of
  Right Doc
d -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Doc -> Pandoc
jiraToPandoc Doc
d
  Left ParseError
e  -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc)
-> (Text -> PandocError) -> Text -> m Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocParseError (Text -> m Pandoc) -> Text -> m Pandoc
forall a b. (a -> b) -> a -> b
$
             Text
"Jira parse error" Text -> Text -> Text
`append` String -> Text
pack (ParseError -> String
forall a. Show a => a -> String
show ParseError
e)

jiraToPandoc :: Jira.Doc -> Pandoc
jiraToPandoc :: Doc -> Pandoc
jiraToPandoc (Jira.Doc [Block]
blks) = Blocks -> Pandoc
doc (Blocks -> Pandoc) -> Blocks -> Pandoc
forall a b. (a -> b) -> a -> b
$ (Block -> Blocks) -> [Block] -> Blocks
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Blocks
jiraToPandocBlocks [Block]
blks

--
-- Blocks
--

-- | Converts a Jira block to a Pandoc block.
jiraToPandocBlocks :: Jira.Block -> Blocks
jiraToPandocBlocks :: Block -> Blocks
jiraToPandocBlocks = \case
  Jira.BlockQuote [Block]
blcks -> Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ (Block -> Blocks) -> [Block] -> Blocks
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Blocks
jiraToPandocBlocks [Block]
blcks
  Jira.Code Language
lang [Parameter]
ps Text
txt -> Maybe Language -> [Parameter] -> Text -> Blocks
toPandocCodeBlocks (Language -> Maybe Language
forall a. a -> Maybe a
Just Language
lang) [Parameter]
ps Text
txt
  Jira.Color ColorName
c [Block]
blcks    -> Attr -> Blocks -> Blocks
divWith (Text
forall a. Monoid a => a
mempty, [Text]
forall a. Monoid a => a
mempty, [(Text
"color", ColorName -> Text
colorName ColorName
c)]) (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
                           (Block -> Blocks) -> [Block] -> Blocks
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Blocks
jiraToPandocBlocks [Block]
blcks
  Jira.Header Int
lvl [Inline]
inlns -> Int -> Inlines -> Blocks
header Int
lvl (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ (Inline -> Inlines) -> [Inline] -> Inlines
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> Inlines
jiraToPandocInlines [Inline]
inlns
  Block
Jira.HorizontalRule   -> Blocks
horizontalRule
  Jira.List ListStyle
style [[Block]]
items -> ListStyle -> [[Block]] -> Blocks
toPandocList ListStyle
style [[Block]]
items
  Jira.NoFormat [Parameter]
ps Text
txt  -> Maybe Language -> [Parameter] -> Text -> Blocks
toPandocCodeBlocks Maybe Language
forall a. Maybe a
Nothing [Parameter]
ps Text
txt
  Jira.Panel [Parameter]
ps [Block]
blcks   -> [Parameter] -> [Block] -> Blocks
toPandocDiv [Parameter]
ps [Block]
blcks
  Jira.Para [Inline]
inlns       -> Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ (Inline -> Inlines) -> [Inline] -> Inlines
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> Inlines
jiraToPandocInlines [Inline]
inlns
  Jira.Table [Row]
rows       -> [Row] -> Blocks
toPandocTable [Row]
rows

-- | Create a pandoc list – either to a @'BulletList'@ or an @'OrderedList'@.
toPandocList :: Jira.ListStyle -> [[Jira.Block]] -> Blocks
toPandocList :: ListStyle -> [[Block]] -> Blocks
toPandocList ListStyle
style [[Block]]
items =
  let items' :: [Blocks]
items' = ([Block] -> Blocks) -> [[Block]] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> Blocks) -> [Block] -> Blocks
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Blocks
jiraToPandocBlocks) [[Block]]
items
  in if ListStyle
style ListStyle -> ListStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListStyle
Jira.Enumeration
     then [Blocks] -> Blocks
orderedList [Blocks]
items'
     else [Blocks] -> Blocks
bulletList [Blocks]
items'

-- | Create a pandoc @'CodeBlock'@
toPandocCodeBlocks :: Maybe Jira.Language -> [Jira.Parameter] -> Text -> Blocks
toPandocCodeBlocks :: Maybe Language -> [Parameter] -> Text -> Blocks
toPandocCodeBlocks Maybe Language
langMay [Parameter]
params Text
txt =
  let classes :: [Text]
classes = case Maybe Language
langMay of
                  Just (Jira.Language Text
lang) -> [Text
lang]
                  Maybe Language
Nothing                   -> []
  in Attr -> Text -> Blocks
codeBlockWith (Text
"", [Text]
classes, (Parameter -> (Text, Text)) -> [Parameter] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Parameter -> (Text, Text)
paramToPair [Parameter]
params) Text
txt

-- | Create a pandoc @'Div'@
toPandocDiv :: [Jira.Parameter] -> [Jira.Block] -> Blocks
toPandocDiv :: [Parameter] -> [Block] -> Blocks
toPandocDiv [Parameter]
params =
  Attr -> Blocks -> Blocks
divWith (Text
"", [], (Parameter -> (Text, Text)) -> [Parameter] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Parameter -> (Text, Text)
paramToPair [Parameter]
params) (Blocks -> Blocks) -> ([Block] -> Blocks) -> [Block] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Blocks) -> [Block] -> Blocks
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Blocks
jiraToPandocBlocks

paramToPair :: Jira.Parameter -> (Text, Text)
paramToPair :: Parameter -> (Text, Text)
paramToPair (Jira.Parameter Text
key Text
value) = (Text
key, Text
value)

-- | Give textual representation of a color.
colorName :: Jira.ColorName -> Text
colorName :: ColorName -> Text
colorName (Jira.ColorName Text
name) = Text
name

-- | Create a pandoc @'Table'@.
-- This relies on 'simpleTable' to sanitize the table.
toPandocTable :: [Jira.Row] -> Blocks
toPandocTable :: [Row] -> Blocks
toPandocTable [Row]
rows =
  let (Row
headerRow, [Row]
bodyRows) = [Row] -> (Row, [Row])
splitIntoHeaderAndBody [Row]
rows
  in [Blocks] -> [[Blocks]] -> Blocks
simpleTable
       (Row -> [Blocks]
rowToBlocksList Row
headerRow)
       ((Row -> [Blocks]) -> [Row] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map Row -> [Blocks]
rowToBlocksList [Row]
bodyRows)

rowToBlocksList :: Jira.Row -> [Blocks]
rowToBlocksList :: Row -> [Blocks]
rowToBlocksList (Jira.Row [Cell]
cells) =
  (Cell -> Blocks) -> [Cell] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Blocks
cellContent [Cell]
cells
  where
    cellContent :: Cell -> Blocks
cellContent Cell
cell = let content :: [Block]
content = case Cell
cell of
                             Jira.HeaderCell x -> [Block]
x
                             Jira.BodyCell x   -> [Block]
x
                       in (Block -> Blocks) -> [Block] -> Blocks
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Blocks
jiraToPandocBlocks [Block]
content

splitIntoHeaderAndBody :: [Jira.Row] -> (Jira.Row, [Jira.Row])
splitIntoHeaderAndBody :: [Row] -> (Row, [Row])
splitIntoHeaderAndBody [] = ([Cell] -> Row
Jira.Row [], [])
splitIntoHeaderAndBody rows :: [Row]
rows@(first :: Row
first@(Jira.Row [Cell]
cells) : [Row]
rest) =
  let isHeaderCell :: Cell -> Bool
isHeaderCell Jira.HeaderCell{} = Bool
True
      isHeaderCell Jira.BodyCell{}   = Bool
False
  in if (Cell -> Bool) -> [Cell] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Cell -> Bool
isHeaderCell [Cell]
cells
     then (Row
first, [Row]
rest)
     else ([Cell] -> Row
Jira.Row [], [Row]
rows)

--
-- Inlines
--

-- | Converts a Jira inline to a Pandoc block.
jiraToPandocInlines :: Jira.Inline -> Inlines
jiraToPandocInlines :: Inline -> Inlines
jiraToPandocInlines = \case
  Jira.Anchor Text
t          -> Attr -> Inlines -> Inlines
spanWith (Text
t, [], []) Inlines
forall a. Monoid a => a
mempty
  Jira.AutoLink URL
url      -> Text -> Text -> Inlines -> Inlines
link (URL -> Text
Jira.fromURL URL
url) Text
"" (Text -> Inlines
str (URL -> Text
Jira.fromURL URL
url))
  Jira.Citation [Inline]
ils      -> Text -> Inlines
str Text
"—" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
emph ([Inline] -> Inlines
fromInlines [Inline]
ils)
  Jira.ColorInline ColorName
c [Inline]
ils -> Attr -> Inlines -> Inlines
spanWith (Text
"", [], [(Text
"color", ColorName -> Text
colorName ColorName
c)]) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$
                                     [Inline] -> Inlines
fromInlines [Inline]
ils
  Jira.Emoji Icon
icon        -> Text -> Inlines
str (Text -> Inlines) -> (Icon -> Text) -> Icon -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Icon -> Text
iconUnicode (Icon -> Inlines) -> Icon -> Inlines
forall a b. (a -> b) -> a -> b
$ Icon
icon
  Jira.Entity Text
entity     -> Text -> Inlines
str (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fromEntity (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text
entity
  Jira.Image [Parameter]
params URL
url  -> let (Text
title, Attr
attr) = [Parameter] -> (Text, Attr)
imgParams [Parameter]
params
                            in Attr -> Text -> Text -> Inlines -> Inlines
imageWith Attr
attr (URL -> Text
Jira.fromURL URL
url) Text
title Inlines
forall a. Monoid a => a
mempty
  Jira.Link LinkType
lt [Inline]
alias URL
url -> LinkType -> [Inline] -> URL -> Inlines
jiraLinkToPandoc LinkType
lt [Inline]
alias URL
url
  Inline
Jira.Linebreak         -> Inlines
linebreak
  Jira.Monospaced [Inline]
inlns  -> Text -> Inlines
code (Text -> Inlines) -> ([Inline] -> Text) -> [Inline] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> ([Inline] -> [Inline]) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> [Inline])
-> ([Inline] -> Inlines) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inlines
fromInlines ([Inline] -> Inlines) -> [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline]
inlns
  Inline
Jira.Space             -> Inlines
space
  Jira.SpecialChar Char
c     -> Text -> Inlines
str (Char -> Text
Data.Text.singleton Char
c)
  Jira.Str Text
t             -> Text -> Inlines
str Text
t
  Jira.Styled InlineStyle
style [Inline]
inlns -> InlineStyle -> Inlines -> Inlines
fromStyle InlineStyle
style (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
fromInlines [Inline]
inlns
  where
    fromInlines :: [Inline] -> Inlines
fromInlines  = (Inline -> Inlines) -> [Inline] -> Inlines
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> Inlines
jiraToPandocInlines
    fromEntity :: Text -> Text
fromEntity Text
e = case String -> Maybe String
lookupEntity (Text -> String
unpack Text
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";") of
                     Maybe String
Nothing -> Text
"&" Text -> Text -> Text
`append` Text
e Text -> Text -> Text
`append` Text
";"
                     Just String
cs -> String -> Text
pack String
cs

    fromStyle :: InlineStyle -> Inlines -> Inlines
fromStyle = \case
      InlineStyle
Jira.Emphasis    -> Inlines -> Inlines
emph
      InlineStyle
Jira.Insert      -> Inlines -> Inlines
underline
      InlineStyle
Jira.Strikeout   -> Inlines -> Inlines
strikeout
      InlineStyle
Jira.Strong      -> Inlines -> Inlines
strong
      InlineStyle
Jira.Subscript   -> Inlines -> Inlines
subscript
      InlineStyle
Jira.Superscript -> Inlines -> Inlines
superscript

    imgParams :: [Jira.Parameter] -> (Text, Attr)
    imgParams :: [Parameter] -> (Text, Attr)
imgParams = (Parameter -> (Text, Attr) -> (Text, Attr))
-> (Text, Attr) -> [Parameter] -> (Text, Attr)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Parameter -> (Text, Attr) -> (Text, Attr)
addImgParam (Text
"", (Text
"", [], []))

    addImgParam :: Jira.Parameter -> (Text, Attr) -> (Text, Attr)
    addImgParam :: Parameter -> (Text, Attr) -> (Text, Attr)
addImgParam Parameter
p (Text
title, attr :: Attr
attr@(Text
ident, [Text]
classes, [(Text, Text)]
kvs)) =
      case Parameter -> Text
Jira.parameterKey Parameter
p of
        Text
"title"     -> (Parameter -> Text
Jira.parameterValue Parameter
p, Attr
attr)
        Text
"thumbnail" -> (Text
title, (Text
ident, Text
"thumbnail"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
classes, [(Text, Text)]
kvs))
        Text
_           -> let kv :: (Text, Text)
kv = (Parameter -> Text
Jira.parameterKey Parameter
p, Parameter -> Text
Jira.parameterValue Parameter
p)
                       in (Text
title, (Text
ident, [Text]
classes, (Text, Text)
kv(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs))

-- | Convert a Jira link to pandoc inlines.
jiraLinkToPandoc :: Jira.LinkType -> [Jira.Inline] -> Jira.URL -> Inlines
jiraLinkToPandoc :: LinkType -> [Inline] -> URL -> Inlines
jiraLinkToPandoc LinkType
linkType [Inline]
alias URL
url =
  let url' :: Text
url' = (if LinkType
linkType LinkType -> LinkType -> Bool
forall a. Eq a => a -> a -> Bool
== LinkType
Jira.User then (Text
"~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) else Text -> Text
forall a. a -> a
id) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ URL -> Text
Jira.fromURL URL
url
      alias' :: Inlines
alias' = case [Inline]
alias of
                 [] -> Text -> Inlines
str Text
url'
                 [Inline]
_  -> (Inline -> Inlines) -> [Inline] -> Inlines
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> Inlines
jiraToPandocInlines [Inline]
alias
  in case LinkType
linkType of
    LinkType
Jira.External   -> Text -> Text -> Inlines -> Inlines
link Text
url' Text
"" Inlines
alias'
    LinkType
Jira.Email      -> Text -> Text -> Inlines -> Inlines
link (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url') Text
"" Inlines
alias'
    LinkType
Jira.Attachment -> Attr -> Text -> Text -> Inlines -> Inlines
linkWith (Text
"", [Text
"attachment"], []) Text
url' Text
"" Inlines
alias'
    LinkType
Jira.User       -> Attr -> Text -> Text -> Inlines -> Inlines
linkWith (Text
"", [Text
"user-account"], []) Text
url' Text
"" Inlines
alias'

-- | Get unicode representation of a Jira icon.
iconUnicode :: Jira.Icon -> Text
iconUnicode :: Icon -> Text
iconUnicode = \case
  Icon
Jira.IconSlightlySmiling -> Text
"🙂"
  Icon
Jira.IconFrowning        -> Text
"🙁"
  Icon
Jira.IconTongue          -> Text
"😛"
  Icon
Jira.IconSmiling         -> Text
"😃"
  Icon
Jira.IconWinking         -> Text
"😉"
  Icon
Jira.IconThumbsUp        -> Text
"👍"
  Icon
Jira.IconThumbsDown      -> Text
"👎"
  Icon
Jira.IconInfo            -> Text
"ℹ"
  Icon
Jira.IconCheckmark       -> Text
"✔"
  Icon
Jira.IconX               -> Text
"❌"
  Icon
Jira.IconAttention       -> Text
"❗"
  Icon
Jira.IconPlus            -> Text
"➕"
  Icon
Jira.IconMinus           -> Text
"➖"
  Icon
Jira.IconQuestionmark    -> Text
"❓"
  Icon
Jira.IconOn              -> Text
"💡"
  Icon
Jira.IconOff             -> Text
"🌙"
  Icon
Jira.IconStar            -> Text
"⭐"
  Icon
Jira.IconStarRed         -> Text
"⭐"
  Icon
Jira.IconStarGreen       -> Text
"⭐"
  Icon
Jira.IconStarBlue        -> Text
"⭐"
  Icon
Jira.IconStarYellow      -> Text
"⭐"
  Icon
Jira.IconFlag            -> Text
"⚑"
  Icon
Jira.IconFlagOff         -> Text
"⚐"