{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
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 Text.Pandoc.Sources (ToSources(..), sourcesToText)
import qualified Text.Jira.Markup as Jira
readJira :: (PandocMonad m, ToSources a)
=> ReaderOptions
-> a
-> m Pandoc
readJira :: ReaderOptions -> a -> m Pandoc
readJira _opts :: ReaderOptions
_opts inp :: 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 d :: 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 e :: 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
$
"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 blks :: [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
jiraToPandocBlocks :: Jira.Block -> Blocks
jiraToPandocBlocks :: Block -> Blocks
jiraToPandocBlocks = \case
Jira.BlockQuote blcks :: [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 lang :: Language
lang ps :: [Parameter]
ps txt :: 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 c :: ColorName
c blcks :: [Block]
blcks -> Attr -> Blocks -> Blocks
divWith (Text
forall a. Monoid a => a
mempty, [Text]
forall a. Monoid a => a
mempty, [("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 lvl :: Int
lvl inlns :: [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
Jira.HorizontalRule -> Blocks
horizontalRule
Jira.List style :: ListStyle
style items :: [[Block]]
items -> ListStyle -> [[Block]] -> Blocks
toPandocList ListStyle
style [[Block]]
items
Jira.NoFormat ps :: [Parameter]
ps txt :: Text
txt -> Maybe Language -> [Parameter] -> Text -> Blocks
toPandocCodeBlocks Maybe Language
forall a. Maybe a
Nothing [Parameter]
ps Text
txt
Jira.Panel ps :: [Parameter]
ps blcks :: [Block]
blcks -> [Parameter] -> [Block] -> Blocks
toPandocDiv [Parameter]
ps [Block]
blcks
Jira.Para inlns :: [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 rows :: [Row]
rows -> [Row] -> Blocks
toPandocTable [Row]
rows
toPandocList :: Jira.ListStyle -> [[Jira.Block]] -> Blocks
toPandocList :: ListStyle -> [[Block]] -> Blocks
toPandocList style :: ListStyle
style items :: [[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'
toPandocCodeBlocks :: Maybe Jira.Language -> [Jira.Parameter] -> Text -> Blocks
toPandocCodeBlocks :: Maybe Language -> [Parameter] -> Text -> Blocks
toPandocCodeBlocks langMay :: Maybe Language
langMay params :: [Parameter]
params txt :: Text
txt =
let classes :: [Text]
classes = case Maybe Language
langMay of
Just (Jira.Language lang :: Text
lang) -> [Text
lang]
Nothing -> []
in Attr -> Text -> Blocks
codeBlockWith ("", [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 params :: [Parameter]
params =
Attr -> Blocks -> Blocks
divWith ("", ["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
. (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 key :: Text
key value :: Text
value) = (Text
key, Text
value)
colorName :: Jira.ColorName -> Text
colorName :: ColorName -> Text
colorName (Jira.ColorName name :: Text
name) = Text
name
toPandocTable :: [Jira.Row] -> Blocks
toPandocTable :: [Row] -> Blocks
toPandocTable rows :: [Row]
rows =
let (headerRow :: Row
headerRow, bodyRows :: [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 cells :: [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
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 cells :: [Cell]
cells) : rest :: [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 t :: Text
t -> Attr -> Inlines -> Inlines
spanWith (Text
t, [], []) Inlines
forall a. Monoid a => a
mempty
Jira.AutoLink url :: URL
url -> Text -> Text -> Inlines -> Inlines
link (URL -> Text
Jira.fromURL URL
url) "" (Text -> Inlines
str (URL -> Text
Jira.fromURL URL
url))
Jira.Citation ils :: [Inline]
ils -> Text -> Inlines
str "—" 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 c :: ColorName
c ils :: [Inline]
ils -> Attr -> Inlines -> Inlines
spanWith ("", [], [("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
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 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 params :: [Parameter]
params url :: URL
url -> let (title :: Text
title, attr :: 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 lt :: LinkType
lt alias :: [Inline]
alias url :: URL
url -> LinkType -> [Inline] -> URL -> Inlines
jiraLinkToPandoc LinkType
lt [Inline]
alias URL
url
Jira.Linebreak -> Inlines
linebreak
Jira.Monospaced inlns :: [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
Jira.Space -> Inlines
space
Jira.SpecialChar c :: Char
c -> Text -> Inlines
str (Char -> Text
Data.Text.singleton Char
c)
Jira.Str t :: Text
t -> Text -> Inlines
str Text
t
Jira.Styled style :: InlineStyle
style inlns :: [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 e :: Text
e = case String -> Maybe String
lookupEntity (Text -> String
unpack Text
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ ";") of
Nothing -> "&" Text -> Text -> Text
`append` Text
e Text -> Text -> Text
`append` ";"
Just cs :: String
cs -> String -> Text
pack String
cs
fromStyle :: InlineStyle -> Inlines -> Inlines
fromStyle = \case
Jira.Emphasis -> Inlines -> Inlines
emph
Jira.Insert -> Inlines -> Inlines
underline
Jira.Strikeout -> Inlines -> Inlines
strikeout
Jira.Strong -> Inlines -> Inlines
strong
Jira.Subscript -> Inlines -> Inlines
subscript
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 ("", ("", [], []))
addImgParam :: Jira.Parameter -> (Text, Attr) -> (Text, Attr)
addImgParam :: Parameter -> (Text, Attr) -> (Text, Attr)
addImgParam p :: Parameter
p (title :: Text
title, attr :: Attr
attr@(ident :: Text
ident, classes :: [Text]
classes, kvs :: [(Text, Text)]
kvs)) =
case Parameter -> Text
Jira.parameterKey Parameter
p of
"title" -> (Parameter -> Text
Jira.parameterValue Parameter
p, Attr
attr)
"thumbnail" -> (Text
title, (Text
ident, "thumbnail"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
classes, [(Text, Text)]
kvs))
_ -> 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
linkType alias :: [Inline]
alias url :: 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
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 -> 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
Jira.External -> Text -> Text -> Inlines -> Inlines
link Text
url' "" Inlines
alias'
Jira.Email -> Text -> Text -> Inlines -> Inlines
link ("mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url') "" Inlines
alias'
Jira.Attachment -> Attr -> Text -> Text -> Inlines -> Inlines
linkWith ("", ["attachment"], []) Text
url' "" Inlines
alias'
Jira.User -> Attr -> Text -> Text -> Inlines -> Inlines
linkWith ("", ["user-account"], []) Text
url' "" Inlines
alias'
Jira.SmartCard -> Attr -> Text -> Text -> Inlines -> Inlines
linkWith ("", ["smart-card"], []) Text
url' "" Inlines
alias'
Jira.SmartLink -> Attr -> Text -> Text -> Inlines -> Inlines
linkWith ("", ["smart-link"], []) Text
url' "" Inlines
alias'
iconUnicode :: Jira.Icon -> Text
iconUnicode :: 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 -> "⚐"