{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-|
Module      : Text.Jira.Parser
Copyright   : © 2019–2020 Albert Krewinkel
License     : MIT

Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>
Stability   : alpha
Portability : portable

Generate Jira wiki markup text from an abstract syntax tree.
-}
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

-- | Render Jira document as Jira wiki formatted text.
pretty :: Doc -> Text
pretty :: Doc -> Text
pretty (Doc blks :: [Block]
blks) = [Block] -> Text
prettyBlocks [Block]
blks

-- | Render a list of Jira blocks as Jira wiki formatted text.
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

-- | Renders a list of Jira inline markup elements.
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
  -- Colon and semicolon only need escaping if they could otherwise
  -- become part of a smiley.
  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

-- | Internal state used by the printer.
data PrinterState = PrinterState
  { PrinterState -> Bool
stateInTable   :: Bool
  , PrinterState -> Text
stateListLevel :: Text
  }

type JiraPrinter a = Reader PrinterState a

-- | Run with default state.
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

-- | Default start state of the printer.
startState :: PrinterState
startState :: PrinterState
startState = PrinterState :: Bool -> Text -> PrinterState
PrinterState
  { stateInTable :: Bool
stateInTable = Bool
False
  , stateListLevel :: Text
stateListLevel = ""
  }

-- | Render a block as Jira wiki format.
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

-- | Combine the texts produced from rendering a list of blocks.
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"

-- | Add a newline character unless we are within a list or table.
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
$
    -- add final newline only if we are neither within a table nor a list.
    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"

-- | Render a block as Jira wiki format.
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)

-- | Returns the ext representation of a color
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   -> '#'

-- | Create a list using the given character as bullet item marker.
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

-- | Convert bullet or ordered list item (list of blocks) to Jira.
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

-- | Renders a single inline item as Jira markup.
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
                              -- backslash is unescapable, render as entity
                              '\\' -> "&bsol;"
                              _    -> "\\" 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 -> '^'

-- | Text rendering of an URL.
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