{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
module Text.Jira.Printer
( pretty
, renderBlock
, renderInline
, prettyBlocks
, prettyInlines
, JiraPrinter
, PrinterState (..)
, startState
, withDefault
) where
import Data.Char (isAlphaNum)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Control.Monad ((<=<))
import Control.Monad.Reader (Reader, runReader, asks, local)
import Data.Text (Text)
import Text.Jira.Markup
import qualified Data.Text as T
pretty :: Doc -> Text
pretty :: Doc -> Text
pretty (Doc [Block]
blks) = [Block] -> Text
prettyBlocks [Block]
blks
prettyBlocks :: [Block] -> Text
prettyBlocks :: [Block] -> Text
prettyBlocks [Block]
blks = Reader PrinterState Text -> PrinterState -> Text
forall r a. Reader r a -> r -> a
runReader ([Block] -> Reader PrinterState Text
renderBlocks [Block]
blks) PrinterState
startState
prettyInlines :: [Inline] -> Text
prettyInlines :: [Inline] -> Text
prettyInlines = \case
[] ->
Text
""
s :: Inline
s@Str{} : Styled InlineStyle
style [Inline]
inlns : [Inline]
rest ->
Inline -> Text
renderInline Inline
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InlineStyle -> [Inline] -> Text
renderStyledSafely InlineStyle
style [Inline]
inlns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
rest
Styled InlineStyle
style [Inline]
inlns : s :: Inline
s@(Str Text
t) : [Inline]
rest | Text -> Bool
startsWithAlphaNum Text
t ->
InlineStyle -> [Inline] -> Text
renderStyledSafely InlineStyle
style [Inline]
inlns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Inline -> Text
renderInline Inline
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
rest
s :: Inline
s@Str{} : SpecialChar Char
c : rest :: [Inline]
rest@(Str {}:[Inline]
_) | Bool -> Bool
not (Char -> Bool
isBrace Char
c) ->
(Inline -> Text
renderInline Inline
s Text -> Char -> Text
`T.snoc` Char
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
rest
s :: Inline
s@Inline
Space : SpecialChar Char
c : rest :: [Inline]
rest@(Space {}:[Inline]
_) | Bool -> Bool
not (Char -> Bool
isBrace Char
c) ->
(Inline -> Text
renderInline Inline
s Text -> Char -> Text
`T.snoc` Char
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
rest
s :: Inline
s@Inline
Linebreak : SpecialChar Char
c : rest :: [Inline]
rest@(Space {}:[Inline]
_) | Bool -> Bool
not (Char -> Bool
isBrace Char
c) ->
(Inline -> Text
renderInline Inline
s Text -> Char -> Text
`T.snoc` Char
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
rest
SpecialChar Char
c : rest :: [Inline]
rest@(Inline
x : [Inline]
_) | Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
':', Char
';'] Bool -> Bool -> Bool
&& Bool -> Bool
not (Inline -> Bool
isSmileyStr Inline
x) ->
Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
rest
[SpecialChar Char
c] | Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
':', Char
';'] ->
Char -> Text
T.singleton Char
c
SpecialChar Char
'?' : [Inline]
rest | Bool -> Bool
not ([Inline] -> Bool
startsWithQuestionMark [Inline]
rest) ->
Text
"?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
rest
(Inline
x:[Inline]
xs) ->
Inline -> Text
renderInline Inline
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
xs
where
isBrace :: Char -> Bool
isBrace = \case
Char
'{' -> Bool
True
Char
'}' -> Bool
True
Char
_ -> Bool
False
startsWithAlphaNum :: Text -> Bool
startsWithAlphaNum Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
c, Text
_) -> Char -> Bool
isAlphaNum Char
c
Maybe (Char, Text)
_ -> Bool
False
isSmileyStr :: Inline -> Bool
isSmileyStr = \case
Str Text
x | Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"D", Text
")", Text
"(", Text
"P"] -> Bool
True
Inline
_ -> Bool
False
startsWithQuestionMark :: [Inline] -> Bool
startsWithQuestionMark = \case
SpecialChar Char
'?' : [Inline]
_ -> Bool
True
[Inline]
_ -> Bool
False
data PrinterState = PrinterState
{ PrinterState -> Bool
stateInTable :: Bool
, PrinterState -> Text
stateListLevel :: Text
}
type JiraPrinter a = Reader PrinterState a
withDefault :: JiraPrinter a -> a
withDefault :: JiraPrinter a -> a
withDefault = (JiraPrinter a -> PrinterState -> a)
-> PrinterState -> JiraPrinter a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip JiraPrinter a -> PrinterState -> a
forall r a. Reader r a -> r -> a
runReader PrinterState
startState
startState :: PrinterState
startState :: PrinterState
startState = PrinterState :: Bool -> Text -> PrinterState
PrinterState
{ stateInTable :: Bool
stateInTable = Bool
False
, stateListLevel :: Text
stateListLevel = Text
""
}
renderBlocks :: [Block] -> JiraPrinter Text
renderBlocks :: [Block] -> Reader PrinterState Text
renderBlocks = [Text] -> Reader PrinterState Text
concatBlocks ([Text] -> Reader PrinterState Text)
-> ([Block] -> ReaderT PrinterState Identity [Text])
-> [Block]
-> Reader PrinterState Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Block -> Reader PrinterState Text)
-> [Block] -> ReaderT PrinterState Identity [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> Reader PrinterState Text
renderBlock
concatBlocks :: [Text] -> JiraPrinter Text
concatBlocks :: [Text] -> Reader PrinterState Text
concatBlocks = Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> ([Text] -> Text) -> [Text] -> Reader PrinterState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n"
appendNewline :: Text -> JiraPrinter Text
appendNewline :: Text -> Reader PrinterState Text
appendNewline Text
text = do
Text
listLevel <- (PrinterState -> Text) -> Reader PrinterState Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrinterState -> Text
stateListLevel
Bool
inTable <- (PrinterState -> Bool) -> ReaderT PrinterState Identity Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrinterState -> Bool
stateInTable
Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$
if Bool
inTable Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> Bool
T.null Text
listLevel)
then Text
text
else Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
renderBlock :: Block -> JiraPrinter Text
renderBlock :: Block -> Reader PrinterState Text
renderBlock = \case
Code Language
lang [Parameter]
params Text
content -> Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"{code:"
, Text -> [Text] -> Text
T.intercalate Text
"|"
(Language -> Text
renderLang Language
lang Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Parameter -> Text) -> [Parameter] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Parameter -> Text
renderParam [Parameter]
params)
, Text
"}\n"
, Text
content
, Text
"\n{code}"
]
Color ColorName
colorName [Block]
blocks -> [Block] -> Reader PrinterState Text
renderBlocks [Block]
blocks Reader PrinterState Text
-> (Text -> Reader PrinterState Text) -> Reader PrinterState Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
blks -> Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"{color:", ColorName -> Text
colorText ColorName
colorName, Text
"}\n"
, Text
blks
, Text
"{color}"
]
BlockQuote [Para [Inline]
xs] | Inline
Linebreak Inline -> [Inline] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Inline]
xs
-> Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ Text
"bq. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
xs
BlockQuote [Block]
blocks -> [Block] -> Reader PrinterState Text
renderBlocks [Block]
blocks Reader PrinterState Text
-> (Text -> Reader PrinterState Text) -> Reader PrinterState Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
blks -> Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"{quote}\n"
, Text
blks
, Text
"{quote}"]
Header Int
lvl [Inline]
inlines -> Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"h", [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lvl), Text
". "
, [Inline] -> Text
prettyInlines [Inline]
inlines
]
Block
HorizontalRule -> Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"----"
List ListStyle
style [[Block]]
items -> [[Block]] -> Char -> Reader PrinterState Text
listWithMarker [[Block]]
items (ListStyle -> Char
styleChar ListStyle
style) Reader PrinterState Text
-> (Text -> Reader PrinterState Text) -> Reader PrinterState Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Text -> Reader PrinterState Text
appendNewline
NoFormat [Parameter]
params Text
content -> Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"{noformat"
, [Parameter] -> Text
renderBlockParams [Parameter]
params
, Text
"}\n"
, Text
content
, Text
"{noformat}"
]
Panel [Parameter]
params [Block]
blocks -> [Block] -> Reader PrinterState Text
renderBlocks [Block]
blocks Reader PrinterState Text
-> (Text -> Reader PrinterState Text) -> Reader PrinterState Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
blks ->
Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"{panel"
, [Parameter] -> Text
renderBlockParams [Parameter]
params
, Text
"}\n"
, Text
blks
, Text
"{panel}"
]
Para [Inline]
inlines -> Text -> Reader PrinterState Text
appendNewline (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
prettyInlines [Inline]
inlines
Table [Row]
rows ->
(PrinterState -> PrinterState)
-> Reader PrinterState Text -> Reader PrinterState Text
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\PrinterState
st -> PrinterState
st { stateInTable :: Bool
stateInTable = Bool
True }) (Reader PrinterState Text -> Reader PrinterState Text)
-> Reader PrinterState Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$
([Text] -> Text)
-> ReaderT PrinterState Identity [Text] -> Reader PrinterState Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
T.unlines ((Row -> Reader PrinterState Text)
-> [Row] -> ReaderT PrinterState Identity [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Row -> Reader PrinterState Text
renderRow [Row]
rows)
colorText :: ColorName -> Text
colorText :: ColorName -> Text
colorText (ColorName Text
c) = Text
c
renderLang :: Language -> Text
renderLang :: Language -> Text
renderLang (Language Text
lang) = Text
lang
renderBlockParams :: [Parameter] -> Text
renderBlockParams :: [Parameter] -> Text
renderBlockParams = \case
[] -> Text
forall a. Monoid a => a
mempty
[Parameter]
xs -> Char -> Text -> Text
T.cons Char
':' ([Parameter] -> Text
renderParams [Parameter]
xs)
renderParams :: [Parameter] -> Text
renderParams :: [Parameter] -> Text
renderParams = Text -> [Text] -> Text
T.intercalate Text
"|" ([Text] -> Text) -> ([Parameter] -> [Text]) -> [Parameter] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parameter -> Text) -> [Parameter] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Parameter -> Text
renderParam
renderParam :: Parameter -> Text
renderParam :: Parameter -> Text
renderParam (Parameter Text
key Text
value) = Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value
renderRow :: Row -> JiraPrinter Text
renderRow :: Row -> Reader PrinterState Text
renderRow (Row [Cell]
cells) = do
[Text]
rendered <- (Cell -> Reader PrinterState Text)
-> [Cell] -> ReaderT PrinterState Identity [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Cell -> Reader PrinterState Text
renderCell [Cell]
cells
let closing :: Text
closing = if (Cell -> Bool) -> [Cell] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Cell -> Bool
isHeaderCell [Cell]
cells then Text
" ||" else Text
" |"
Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
rendered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
closing
where
isHeaderCell :: Cell -> Bool
isHeaderCell HeaderCell {} = Bool
True
isHeaderCell BodyCell {} = Bool
False
renderCell :: Cell -> JiraPrinter Text
renderCell :: Cell -> Reader PrinterState Text
renderCell Cell
cell = let (Text
cellStart, [Block]
blocks) = case Cell
cell of
(HeaderCell [Block]
bs) -> (Text
"|| ", [Block]
bs)
(BodyCell [Block]
bs) -> (Text
"| ", [Block]
bs)
in (Text
cellStart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> Reader PrinterState Text -> Reader PrinterState Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Reader PrinterState Text
renderBlocks [Block]
blocks
styleChar :: ListStyle -> Char
styleChar :: ListStyle -> Char
styleChar = \case
ListStyle
CircleBullets -> Char
'*'
ListStyle
SquareBullets -> Char
'-'
ListStyle
Enumeration -> Char
'#'
listWithMarker :: [[Block]]
-> Char
-> JiraPrinter Text
listWithMarker :: [[Block]] -> Char -> Reader PrinterState Text
listWithMarker [[Block]]
items Char
marker = do
let addItem :: PrinterState -> PrinterState
addItem PrinterState
s = PrinterState
s { stateListLevel :: Text
stateListLevel = PrinterState -> Text
stateListLevel PrinterState
s Text -> Char -> Text
`T.snoc` Char
marker }
[Text]
renderedBlocks <- (PrinterState -> PrinterState)
-> ReaderT PrinterState Identity [Text]
-> ReaderT PrinterState Identity [Text]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local PrinterState -> PrinterState
addItem (ReaderT PrinterState Identity [Text]
-> ReaderT PrinterState Identity [Text])
-> ReaderT PrinterState Identity [Text]
-> ReaderT PrinterState Identity [Text]
forall a b. (a -> b) -> a -> b
$ ([Block] -> Reader PrinterState Text)
-> [[Block]] -> ReaderT PrinterState Identity [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> Reader PrinterState Text
listItemToJira [[Block]]
items
Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
renderedBlocks
listItemToJira :: [Block]
-> JiraPrinter Text
listItemToJira :: [Block] -> Reader PrinterState Text
listItemToJira [Block]
items = do
Text
contents <- [Block] -> Reader PrinterState Text
renderBlocks [Block]
items
Text
marker <- (PrinterState -> Text) -> Reader PrinterState Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PrinterState -> Text
stateListLevel
Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Reader PrinterState Text)
-> Text -> Reader PrinterState Text
forall a b. (a -> b) -> a -> b
$ case [Block]
items of
List{} : [Block]
_ -> Text
contents
[Block]
_ -> Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
renderInline :: Inline -> Text
renderInline :: Inline -> Text
renderInline = \case
Anchor Text
name -> Text
"{anchor:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
AutoLink URL
url -> URL -> Text
fromURL URL
url
Citation [Inline]
ils -> Text
"??" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
ils Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"??"
ColorInline ColorName
color [Inline]
ils -> Text
"{color:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColorName -> Text
colorText ColorName
color Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
[Inline] -> Text
prettyInlines [Inline]
ils Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{color}"
Emoji Icon
icon -> Icon -> Text
iconText Icon
icon
Entity Text
entity -> Text
"&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
entity Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
Image [Parameter]
ps URL
url -> Text
"!" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> URL -> Text
fromURL URL
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Parameter] -> Text
renderImageParams [Parameter]
ps Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!"
Inline
Linebreak -> Text
"\n"
Link LinkType
lt [Inline]
ils URL
url -> LinkType -> [Inline] -> URL -> Text
renderLink LinkType
lt [Inline]
ils URL
url
Monospaced [Inline]
inlines -> Text
"{{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
inlines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}}"
Inline
Space -> Text
" "
SpecialChar Char
c -> case Char
c of
Char
'\\' -> Text
"\"
Char
_ -> Text
"\\" Text -> Char -> Text
`T.snoc` Char
c
Str Text
txt -> Text
txt
Styled InlineStyle
style [Inline]
inlines -> Char -> [Inline] -> Text
renderWrapped (InlineStyle -> Char
delimiterChar InlineStyle
style) [Inline]
inlines
renderStyledSafely :: InlineStyle -> [Inline] -> Text
renderStyledSafely :: InlineStyle -> [Inline] -> Text
renderStyledSafely InlineStyle
style =
let delim :: Text
delim = [Char] -> Text
T.pack [Char
'{', InlineStyle -> Char
delimiterChar InlineStyle
style, Char
'}']
in (Text
delim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
delim) (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
prettyInlines
renderLink :: LinkType -> [Inline] -> URL -> Text
renderLink :: LinkType -> [Inline] -> URL -> Text
renderLink LinkType
linkType [Inline]
inlines URL
url = case LinkType
linkType of
LinkType
Attachment -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
inlines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> URL -> Text
fromURL URL
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
LinkType
Email -> Text -> Text
link' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> URL -> Text
fromURL URL
url
LinkType
External -> Text -> Text
link' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ URL -> Text
fromURL URL
url
LinkType
SmartCard -> Text -> Text -> Text
smartLink (URL -> Text
fromURL URL
url) Text
"smart-card"
LinkType
SmartLink -> Text -> Text -> Text
smartLink (URL -> Text
fromURL URL
url) Text
"smart-link"
LinkType
User -> Text -> Text
link' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> URL -> Text
fromURL URL
url
where
link' :: Text -> Text
link' Text
urlText = case [Inline]
inlines of
[] -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
urlText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
[Inline]
_ -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
inlines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
urlText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
smartLink :: Text -> Text -> Text
smartLink Text
urlText Text
smartType =
Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
inlines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
urlText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
smartType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
delimiterChar :: InlineStyle -> Char
delimiterChar :: InlineStyle -> Char
delimiterChar = \case
InlineStyle
Emphasis -> Char
'_'
InlineStyle
Insert -> Char
'+'
InlineStyle
Strong -> Char
'*'
InlineStyle
Strikeout -> Char
'-'
InlineStyle
Subscript -> Char
'~'
InlineStyle
Superscript -> Char
'^'
renderImageParams :: [Parameter] -> Text
renderImageParams :: [Parameter] -> Text
renderImageParams = \case
[] -> Text
""
[Parameter]
ps | Text
"thumbnail" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Parameter -> Text) -> [Parameter] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Parameter -> Text
parameterKey [Parameter]
ps -> Text
"|thumbnail"
[Parameter]
ps -> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((Parameter -> Text) -> [Parameter] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Parameter -> Text
renderParam [Parameter]
ps)
renderWrapped :: Char -> [Inline] -> Text
renderWrapped :: Char -> [Inline] -> Text
renderWrapped Char
c = Char -> Text -> Text
T.cons Char
c (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
c (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
prettyInlines