{-# 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 :: 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.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]
_ URL
url       -> Text -> Text -> Inlines -> Inlines
image (URL -> Text
Jira.fromURL URL
url)  Text
"" Inlines
forall a. Monoid a => a
mempty
  Jira.Link [Inline]
alias URL
url    -> Text -> Text -> Inlines -> Inlines
link (URL -> Text
Jira.fromURL URL
url) Text
"" ([Inline] -> Inlines
fromInlines [Inline]
alias)
  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      -> Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
"inserted"], [])
      InlineStyle
Jira.Strikeout   -> Inlines -> Inlines
strikeout
      InlineStyle
Jira.Strong      -> Inlines -> Inlines
strong
      InlineStyle
Jira.Subscript   -> Inlines -> Inlines
subscript
      InlineStyle
Jira.Superscript -> Inlines -> Inlines
superscript

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