{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.Jira ( readJira ) where
import Control.Monad.Except (throwError)
import Data.List (partition)
import Data.Text (Text, append, pack, singleton)
import Text.Pandoc.XML (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 Text.Pandoc.Sources (ToSources(..), sourcesToText)
import qualified Text.Jira.Markup as Jira
readJira :: (PandocMonad m, ToSources a)
=> ReaderOptions
-> a
-> m Pandoc
readJira :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readJira ReaderOptions
_opts a
inp = do
let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
inp
case Text -> Either ParseError Doc
parse (Sources -> Text
sourcesToText Sources
sources) of
Right Doc
d -> Pandoc -> m Pandoc
forall a. a -> m a
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 a. PandocError -> m a
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 m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Blocks
jiraToPandocBlocks [Block]
blks
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 m a. Monoid m => (a -> m) -> [a] -> m
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 m a. Monoid m => (a -> m) -> [a] -> m
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 m a. Monoid m => (a -> m) -> [a] -> m
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 m a. Monoid m => (a -> m) -> [a] -> m
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
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 m a. Monoid m => (a -> m) -> [a] -> m
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'
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
toPandocDiv :: [Jira.Parameter] -> [Jira.Block] -> Blocks
toPandocDiv :: [Parameter] -> [Block] -> Blocks
toPandocDiv [Parameter]
params =
let ([Parameter]
titles, [Parameter]
params') = (Parameter -> Bool) -> [Parameter] -> ([Parameter], [Parameter])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"title") (Text -> Bool) -> (Parameter -> Text) -> Parameter -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parameter -> Text
Jira.parameterKey) [Parameter]
params
addTitle :: Blocks -> Blocks
addTitle = case [Parameter]
titles of
[] ->
Blocks -> Blocks
forall a. a -> a
id
(Parameter
title:[Parameter]
_) -> \Blocks
blks ->
(Attr -> Blocks -> Blocks
divWith (Text
"", [Text
"panelheader"], []) (Blocks -> Blocks) -> (Inlines -> Blocks) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
plain (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
strong (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$
Text -> Inlines
text (Parameter -> Text
Jira.parameterValue Parameter
title)) Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
blks
in Attr -> Blocks -> Blocks
divWith (Text
"", [Text
"panel"], (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
. Blocks -> Blocks
addTitle
(Blocks -> Blocks) -> ([Block] -> Blocks) -> [Block] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Blocks) -> [Block] -> Blocks
forall m a. Monoid m => (a -> m) -> [a] -> m
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)
colorName :: Jira.ColorName -> Text
colorName :: ColorName -> Text
colorName (Jira.ColorName Text
name) = Text
name
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 [Block]
x -> [Block]
x
Jira.BodyCell [Block]
x -> [Block]
x
in (Block -> Blocks) -> [Block] -> Blocks
forall m a. Monoid m => (a -> m) -> [a] -> m
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)
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 m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> Inlines
jiraToPandocInlines
fromEntity :: Text -> Text
fromEntity Text
e = case Text -> Maybe Text
lookupEntity (Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";") of
Maybe Text
Nothing -> Text
"&" Text -> Text -> Text
`append` Text
e Text -> Text -> Text
`append` Text
";"
Just Text
t ->Text
t
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 a b. (a -> b -> b) -> b -> [a] -> b
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))
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 m a. Monoid m => (a -> m) -> [a] -> m
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'
LinkType
Jira.SmartCard -> Attr -> Text -> Text -> Inlines -> Inlines
linkWith (Text
"", [Text
"smart-card"], []) Text
url' Text
"" Inlines
alias'
LinkType
Jira.SmartLink -> Attr -> Text -> Text -> Inlines -> Inlines
linkWith (Text
"", [Text
"smart-link"], []) Text
url' Text
"" Inlines
alias'
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
"⚐"