{-# 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 blks :: [Block]
blks) = [Block] -> Text
prettyBlocks [Block]
blks
prettyBlocks :: [Block] -> Text
prettyBlocks :: [Block] -> Text
prettyBlocks blks :: [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
[] ->
""
s :: Inline
s@Str{} : Styled style :: InlineStyle
style inlns :: [Inline]
inlns : rest :: [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 style :: InlineStyle
style inlns :: [Inline]
inlns : s :: Inline
s@(Str t :: Text
t) : rest :: [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 c :: Char
c : rest :: [Inline]
rest@(Str {}:_) ->
(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 c :: Char
c : rest :: [Inline]
rest@(Space {}:_) ->
(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 c :: Char
c : rest :: [Inline]
rest@(Space {}:_) ->
(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 c :: Char
c : rest :: [Inline]
rest@(x :: Inline
x : _) | Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [':', ';'] 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 c :: Char
c] | Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [':', ';'] ->
Char -> Text
T.singleton Char
c
(x :: Inline
x:xs :: [Inline]
xs) ->
Inline -> Text
renderInline Inline
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
xs
where
startsWithAlphaNum :: Text -> Bool
startsWithAlphaNum t :: Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (c :: Char
c, _) -> Char -> Bool
isAlphaNum Char
c
_ -> Bool
False
isSmileyStr :: Inline -> Bool
isSmileyStr = \case
Str x :: Text
x | Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["D", ")", "(", "P"] -> Bool
True
_ -> 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 = ""
}
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 "\n"
appendNewline :: Text -> JiraPrinter Text
appendNewline :: Text -> Reader PrinterState Text
appendNewline text :: 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
<> "\n"
renderBlock :: Block -> JiraPrinter Text
renderBlock :: Block -> Reader PrinterState Text
renderBlock = \case
Code lang :: Language
lang params :: [Parameter]
params content :: 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
[ "{code:"
, Text -> [Text] -> Text
T.intercalate "|"
(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)
, "}\n"
, Text
content
, "\n{code}"
]
Color colorName :: ColorName
colorName blocks :: [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
>>= \blks :: 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
[ "{color:", ColorName -> Text
colorText ColorName
colorName, "}\n"
, Text
blks
, "{color}"
]
BlockQuote [Para xs :: [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
$ "bq. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
prettyInlines [Inline]
xs
BlockQuote blocks :: [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
>>= \blks :: 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
[ "{quote}\n"
, Text
blks
, "\n{quote}"]
Header lvl :: Int
lvl inlines :: [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
[ "h", [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lvl), ". "
, [Inline] -> Text
prettyInlines [Inline]
inlines
]
HorizontalRule -> Text -> Reader PrinterState Text
forall (m :: * -> *) a. Monad m => a -> m a
return "----"
List style :: ListStyle
style items :: [[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 params :: [Parameter]
params content :: 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
[ "{noformat"
, [Parameter] -> Text
renderBlockParams [Parameter]
params
, "}\n"
, Text
content
, "{noformat}"
]
Panel params :: [Parameter]
params blocks :: [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
>>= \blks :: 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
[ "{panel"
, [Parameter] -> Text
renderBlockParams [Parameter]
params
, "}\n"
, Text
blks
, "{panel}"
]
Para inlines :: [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 rows :: [Row]
rows ->
(PrinterState -> PrinterState)
-> Reader PrinterState Text -> Reader PrinterState Text
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\st :: 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 c :: Text
c) = Text
c
renderLang :: Language -> Text
renderLang :: Language -> Text
renderLang (Language lang :: Text
lang) = Text
lang
renderBlockParams :: [Parameter] -> Text
renderBlockParams :: [Parameter] -> Text
renderBlockParams = \case
[] -> Text
forall a. Monoid a => a
mempty
xs :: [Parameter]
xs -> Char -> Text -> Text
T.cons ':' ([Parameter] -> Text
renderParams [Parameter]
xs)
renderParams :: [Parameter] -> Text
renderParams :: [Parameter] -> Text
renderParams = Text -> [Text] -> Text
T.intercalate "|" ([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 key :: Text
key value :: Text
value) = Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value
renderRow :: Row -> JiraPrinter Text
renderRow :: Row -> Reader PrinterState Text
renderRow (Row cells :: [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 " ||" else " |"
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
cell = let (cellStart :: Text
cellStart, blocks :: [Block]
blocks) = case Cell
cell of
(HeaderCell bs :: [Block]
bs) -> ("|| ", [Block]
bs)
(BodyCell bs :: [Block]
bs) -> ("| ", [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
CircleBullets -> '*'
SquareBullets -> '-'
Enumeration -> '#'
listWithMarker :: [[Block]]
-> Char
-> JiraPrinter Text
listWithMarker :: [[Block]] -> Char -> Reader PrinterState Text
listWithMarker items :: [[Block]]
items marker :: Char
marker = do
let addItem :: PrinterState -> PrinterState
addItem s :: 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 "\n" [Text]
renderedBlocks
listItemToJira :: [Block]
-> JiraPrinter Text
listItemToJira :: [Block] -> Reader PrinterState Text
listItemToJira items :: [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{} : _ -> Text
contents
_ -> Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
renderInline :: Inline -> Text
renderInline :: Inline -> Text
renderInline = \case
Anchor name :: Text
name -> "{anchor:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"
AutoLink url :: URL
url -> URL -> Text
urlText URL
url
ColorInline color :: ColorName
color ils :: [Inline]
ils -> "{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
forall a. Semigroup a => a -> a -> a
<>
[Inline] -> Text
prettyInlines [Inline]
ils Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "{color}"
Emoji icon :: Icon
icon -> Icon -> Text
iconText Icon
icon
Entity entity :: Text
entity -> "&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
entity Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ";"
Image params :: [Parameter]
params url :: URL
url -> "!" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> URL -> Text
urlText URL
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
if [Parameter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Parameter]
params
then "!"
else "|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Parameter] -> Text
renderParams [Parameter]
params Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "!"
Linebreak -> "\n"
Link inlines :: [Inline]
inlines (URL url :: Text
url) -> "[" 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
forall a. Semigroup a => a -> a -> a
<> Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
Monospaced inlines :: [Inline]
inlines -> "{{" 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
<> "}}"
Space -> " "
SpecialChar c :: Char
c -> case Char
c of
'\\' -> "\"
_ -> "\\" Text -> Char -> Text
`T.snoc` Char
c
Str txt :: Text
txt -> Text
txt
Styled style :: InlineStyle
style inlines :: [Inline]
inlines -> Char -> [Inline] -> Text
renderWrapped (InlineStyle -> Char
delimiterChar InlineStyle
style) [Inline]
inlines
renderStyledSafely :: InlineStyle -> [Inline] -> Text
renderStyledSafely :: InlineStyle -> [Inline] -> Text
renderStyledSafely style :: InlineStyle
style =
let delim :: Text
delim = [Char] -> Text
T.pack ['{', InlineStyle -> Char
delimiterChar InlineStyle
style, '}']
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
delimiterChar :: InlineStyle -> Char
delimiterChar :: InlineStyle -> Char
delimiterChar = \case
Emphasis -> '_'
Insert -> '+'
Strong -> '*'
Strikeout -> '-'
Subscript -> '~'
Superscript -> '^'
urlText :: URL -> Text
urlText :: URL -> Text
urlText (URL url :: Text
url) = Text
url
renderWrapped :: Char -> [Inline] -> Text
renderWrapped :: Char -> [Inline] -> Text
renderWrapped c :: 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