{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-|
Module      : Text.Jira.Parser
Copyright   : © 2019–2021 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 [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 [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
  [] ->
    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
  -- Most special chars don't need escaping when surrounded by spaces or within
  -- a word. Braces are the exception, they should always be escaped.
  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
  -- Colon and semicolon only need escaping if they could otherwise
  -- become part of a smiley.
  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
  -- Questionmarks don't have to be escaped unless in groups of two
  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

-- | 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 = Text
""
  }

-- | 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 Text
"\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 = 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
<> Text
"\n"

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

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

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

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

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

-- | Render image parameters (i.e., separate by comma).
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