{-# 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) = Many Block -> Pandoc
doc (Many Block -> Pandoc) -> Many Block -> Pandoc
forall a b. (a -> b) -> a -> b
$ (Block -> Many Block) -> [Block] -> Many Block
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Many Block
jiraToPandocBlocks [Block]
blks
jiraToPandocBlocks :: Jira.Block -> Blocks
jiraToPandocBlocks :: Block -> Many Block
jiraToPandocBlocks = \case
Jira.BlockQuote [Block]
blcks -> Many Block -> Many Block
blockQuote (Many Block -> Many Block) -> Many Block -> Many Block
forall a b. (a -> b) -> a -> b
$ (Block -> Many Block) -> [Block] -> Many Block
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Many Block
jiraToPandocBlocks [Block]
blcks
Jira.Code Language
lang [Parameter]
ps Text
txt -> Maybe Language -> [Parameter] -> Text -> Many Block
toPandocCodeBlocks (Language -> Maybe Language
forall a. a -> Maybe a
Just Language
lang) [Parameter]
ps Text
txt
Jira.Color ColorName
c [Block]
blcks -> Attr -> Many Block -> Many Block
divWith (Text
forall a. Monoid a => a
mempty, [Text]
forall a. Monoid a => a
mempty, [(Text
"color", ColorName -> Text
colorName ColorName
c)]) (Many Block -> Many Block) -> Many Block -> Many Block
forall a b. (a -> b) -> a -> b
$
(Block -> Many Block) -> [Block] -> Many Block
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Many Block
jiraToPandocBlocks [Block]
blcks
Jira.Header Int
lvl [Inline]
inlns -> Int -> Many Inline -> Many Block
header Int
lvl (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ (Inline -> Many Inline) -> [Inline] -> Many Inline
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> Many Inline
jiraToPandocInlines [Inline]
inlns
Block
Jira.HorizontalRule -> Many Block
horizontalRule
Jira.List ListStyle
style [[Block]]
items -> ListStyle -> [[Block]] -> Many Block
toPandocList ListStyle
style [[Block]]
items
Jira.NoFormat [Parameter]
ps Text
txt -> Maybe Language -> [Parameter] -> Text -> Many Block
toPandocCodeBlocks Maybe Language
forall a. Maybe a
Nothing [Parameter]
ps Text
txt
Jira.Panel [Parameter]
ps [Block]
blcks -> [Parameter] -> [Block] -> Many Block
toPandocDiv [Parameter]
ps [Block]
blcks
Jira.Para [Inline]
inlns -> Many Inline -> Many Block
para (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ (Inline -> Many Inline) -> [Inline] -> Many Inline
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> Many Inline
jiraToPandocInlines [Inline]
inlns
Jira.Table [Row]
rows -> [Row] -> Many Block
toPandocTable [Row]
rows
toPandocList :: Jira.ListStyle -> [[Jira.Block]] -> Blocks
toPandocList :: ListStyle -> [[Block]] -> Many Block
toPandocList ListStyle
style [[Block]]
items =
let items' :: [Many Block]
items' = ([Block] -> Many Block) -> [[Block]] -> [Many Block]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> Many Block) -> [Block] -> Many Block
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Many Block
jiraToPandocBlocks) [[Block]]
items
in if ListStyle
style ListStyle -> ListStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListStyle
Jira.Enumeration
then [Many Block] -> Many Block
orderedList [Many Block]
items'
else [Many Block] -> Many Block
bulletList [Many Block]
items'
toPandocCodeBlocks :: Maybe Jira.Language -> [Jira.Parameter] -> Text -> Blocks
toPandocCodeBlocks :: Maybe Language -> [Parameter] -> Text -> Many Block
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 -> Many Block
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] -> Many Block
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 :: Many Block -> Many Block
addTitle = case [Parameter]
titles of
[] ->
Many Block -> Many Block
forall a. a -> a
id
(Parameter
title:[Parameter]
_) -> \Many Block
blks ->
(Attr -> Many Block -> Many Block
divWith (Text
"", [Text
"panelheader"], []) (Many Block -> Many Block)
-> (Many Inline -> Many Block) -> Many Inline -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Block
plain (Many Inline -> Many Block)
-> (Many Inline -> Many Inline) -> Many Inline -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
strong (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$
Text -> Many Inline
text (Parameter -> Text
Jira.parameterValue Parameter
title)) Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> Many Block
blks
in Attr -> Many Block -> Many Block
divWith (Text
"", [Text
"panel"], (Parameter -> (Text, Text)) -> [Parameter] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Parameter -> (Text, Text)
paramToPair [Parameter]
params')
(Many Block -> Many Block)
-> ([Block] -> Many Block) -> [Block] -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Block -> Many Block
addTitle
(Many Block -> Many Block)
-> ([Block] -> Many Block) -> [Block] -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Many Block) -> [Block] -> Many Block
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Many Block
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] -> Many Block
toPandocTable [Row]
rows =
let (Row
headerRow, [Row]
bodyRows) = [Row] -> (Row, [Row])
splitIntoHeaderAndBody [Row]
rows
in [Many Block] -> [[Many Block]] -> Many Block
simpleTable
(Row -> [Many Block]
rowToBlocksList Row
headerRow)
((Row -> [Many Block]) -> [Row] -> [[Many Block]]
forall a b. (a -> b) -> [a] -> [b]
map Row -> [Many Block]
rowToBlocksList [Row]
bodyRows)
rowToBlocksList :: Jira.Row -> [Blocks]
rowToBlocksList :: Row -> [Many Block]
rowToBlocksList (Jira.Row [Cell]
cells) =
(Cell -> Many Block) -> [Cell] -> [Many Block]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Many Block
cellContent [Cell]
cells
where
cellContent :: Cell -> Many Block
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 -> Many Block) -> [Block] -> Many Block
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Block -> Many Block
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 -> Many Inline
jiraToPandocInlines = \case
Jira.Anchor Text
t -> Attr -> Many Inline -> Many Inline
spanWith (Text
t, [], []) Many Inline
forall a. Monoid a => a
mempty
Jira.AutoLink URL
url -> Text -> Text -> Many Inline -> Many Inline
link (URL -> Text
Jira.fromURL URL
url) Text
"" (Text -> Many Inline
str (URL -> Text
Jira.fromURL URL
url))
Jira.Citation [Inline]
ils -> Text -> Many Inline
str Text
"—" Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline
space Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline -> Many Inline
emph ([Inline] -> Many Inline
fromInlines [Inline]
ils)
Jira.ColorInline ColorName
c [Inline]
ils -> Attr -> Many Inline -> Many Inline
spanWith (Text
"", [], [(Text
"color", ColorName -> Text
colorName ColorName
c)]) (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$
[Inline] -> Many Inline
fromInlines [Inline]
ils
Jira.Emoji Icon
icon -> Text -> Many Inline
str (Text -> Many Inline) -> (Icon -> Text) -> Icon -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Icon -> Text
iconUnicode (Icon -> Many Inline) -> Icon -> Many Inline
forall a b. (a -> b) -> a -> b
$ Icon
icon
Jira.Entity Text
entity -> Text -> Many Inline
str (Text -> Many Inline) -> (Text -> Text) -> Text -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fromEntity (Text -> Many Inline) -> Text -> Many Inline
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 -> Many Inline -> Many Inline
imageWith Attr
attr (URL -> Text
Jira.fromURL URL
url) Text
title Many Inline
forall a. Monoid a => a
mempty
Jira.Link LinkType
lt [Inline]
alias URL
url -> LinkType -> [Inline] -> URL -> Many Inline
jiraLinkToPandoc LinkType
lt [Inline]
alias URL
url
Inline
Jira.Linebreak -> Many Inline
linebreak
Jira.Monospaced [Inline]
inlns -> Text -> Many Inline
code (Text -> Many Inline)
-> ([Inline] -> Text) -> [Inline] -> Many Inline
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
. Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline])
-> ([Inline] -> Many Inline) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Many Inline
fromInlines ([Inline] -> Many Inline) -> [Inline] -> Many Inline
forall a b. (a -> b) -> a -> b
$ [Inline]
inlns
Inline
Jira.Space -> Many Inline
space
Jira.SpecialChar Char
c -> Text -> Many Inline
str (Char -> Text
Data.Text.singleton Char
c)
Jira.Str Text
t -> Text -> Many Inline
str Text
t
Jira.Styled InlineStyle
style [Inline]
inlns -> InlineStyle -> Many Inline -> Many Inline
fromStyle InlineStyle
style (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ [Inline] -> Many Inline
fromInlines [Inline]
inlns
where
fromInlines :: [Inline] -> Many Inline
fromInlines = (Inline -> Many Inline) -> [Inline] -> Many Inline
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> Many Inline
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 -> Many Inline -> Many Inline
fromStyle = \case
InlineStyle
Jira.Emphasis -> Many Inline -> Many Inline
emph
InlineStyle
Jira.Insert -> Many Inline -> Many Inline
underline
InlineStyle
Jira.Strikeout -> Many Inline -> Many Inline
strikeout
InlineStyle
Jira.Strong -> Many Inline -> Many Inline
strong
InlineStyle
Jira.Subscript -> Many Inline -> Many Inline
subscript
InlineStyle
Jira.Superscript -> Many Inline -> Many Inline
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 -> Many Inline
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' :: Many Inline
alias' = case [Inline]
alias of
[] -> Text -> Many Inline
str Text
url'
[Inline]
_ -> (Inline -> Many Inline) -> [Inline] -> Many Inline
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Inline -> Many Inline
jiraToPandocInlines [Inline]
alias
in case LinkType
linkType of
LinkType
Jira.External -> Text -> Text -> Many Inline -> Many Inline
link Text
url' Text
"" Many Inline
alias'
LinkType
Jira.Email -> Text -> Text -> Many Inline -> Many Inline
link (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url') Text
"" Many Inline
alias'
LinkType
Jira.Attachment -> Attr -> Text -> Text -> Many Inline -> Many Inline
linkWith (Text
"", [Text
"attachment"], []) Text
url' Text
"" Many Inline
alias'
LinkType
Jira.User -> Attr -> Text -> Text -> Many Inline -> Many Inline
linkWith (Text
"", [Text
"user-account"], []) Text
url' Text
"" Many Inline
alias'
LinkType
Jira.SmartCard -> Attr -> Text -> Text -> Many Inline -> Many Inline
linkWith (Text
"", [Text
"smart-card"], []) Text
url' Text
"" Many Inline
alias'
LinkType
Jira.SmartLink -> Attr -> Text -> Text -> Many Inline -> Many Inline
linkWith (Text
"", [Text
"smart-link"], []) Text
url' Text
"" Many Inline
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
"⚐"