{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | See https://api.slack.com/docs/message-formatting
module Web.Slack.MessageParser
  ( messageToHtml,
    HtmlRenderers (..),
    defaultHtmlRenderers,
  )
where

-- FIXME: Web.Slack.Prelude

-- base
import Control.Monad
-- megaparsec

-- mtl
import Data.Functor.Identity
import Data.List (intercalate)
import Data.Maybe
-- slack-web

-- text
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
import Web.Slack.Types
import Prelude

newtype SlackUrl = SlackUrl {SlackUrl -> Text
unSlackUrl :: Text}
  deriving stock (Int -> SlackUrl -> ShowS
[SlackUrl] -> ShowS
SlackUrl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlackUrl] -> ShowS
$cshowList :: [SlackUrl] -> ShowS
show :: SlackUrl -> String
$cshow :: SlackUrl -> String
showsPrec :: Int -> SlackUrl -> ShowS
$cshowsPrec :: Int -> SlackUrl -> ShowS
Show, SlackUrl -> SlackUrl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlackUrl -> SlackUrl -> Bool
$c/= :: SlackUrl -> SlackUrl -> Bool
== :: SlackUrl -> SlackUrl -> Bool
$c== :: SlackUrl -> SlackUrl -> Bool
Eq)

data SlackMsgItem
  = SlackMsgItemPlainText Text
  | SlackMsgItemBoldSection [SlackMsgItem]
  | SlackMsgItemItalicsSection [SlackMsgItem]
  | SlackMsgItemStrikethroughSection [SlackMsgItem]
  | SlackMsgItemLink Text SlackUrl
  | SlackMsgItemUserLink UserId (Maybe Text)
  | SlackMsgItemInlineCodeSection Text
  | SlackMsgItemCodeSection Text
  | SlackMsgItemQuoted [SlackMsgItem]
  | SlackMsgItemEmoticon Text
  deriving stock (Int -> SlackMsgItem -> ShowS
[SlackMsgItem] -> ShowS
SlackMsgItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlackMsgItem] -> ShowS
$cshowList :: [SlackMsgItem] -> ShowS
show :: SlackMsgItem -> String
$cshow :: SlackMsgItem -> String
showsPrec :: Int -> SlackMsgItem -> ShowS
$cshowsPrec :: Int -> SlackMsgItem -> ShowS
Show, SlackMsgItem -> SlackMsgItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlackMsgItem -> SlackMsgItem -> Bool
$c/= :: SlackMsgItem -> SlackMsgItem -> Bool
== :: SlackMsgItem -> SlackMsgItem -> Bool
$c== :: SlackMsgItem -> SlackMsgItem -> Bool
Eq)

#if MIN_VERSION_megaparsec(6,0,0)
type MegaparsecError = Void
#else
type MegaparsecError = Dec
#endif

#if MIN_VERSION_megaparsec(7,0,0)
#else
anySingle :: ParsecT MegaparsecError Text Identity (Token Text)
anySingle = anyChar
#endif

type SlackParser a = ParsecT MegaparsecError T.Text Identity a

parseMessage :: Text -> [SlackMsgItem]
parseMessage :: Text -> [SlackMsgItem]
parseMessage Text
input =
  forall a. a -> Maybe a -> a
fromMaybe [Text -> SlackMsgItem
SlackMsgItemPlainText Text
input] forall a b. (a -> b) -> a -> b
$
    forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$ Bool -> SlackParser SlackMsgItem
parseMessageItem Bool
True) Text
input

parseMessageItem :: Bool -> SlackParser SlackMsgItem
parseMessageItem :: Bool -> SlackParser SlackMsgItem
parseMessageItem Bool
acceptNewlines =
  SlackParser SlackMsgItem
parseBoldSection
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
parseItalicsSection
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
parseStrikethroughSection
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try SlackParser SlackMsgItem
parseEmoticon
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
parseCode
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
parseInlineCode
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
parseUserLink
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
parseLink
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
parseBlockQuote
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
parsePlainText
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> SlackParser SlackMsgItem
parseWhitespace Bool
acceptNewlines

parsePlainText :: SlackParser SlackMsgItem
parsePlainText :: SlackParser SlackMsgItem
parsePlainText =
  Text -> SlackMsgItem
SlackMsgItemPlainText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
someTill
      (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
stopChars)
      ( forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
stopChars)
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$ Char -> ParsecT MegaparsecError Text Identity ()
sectionEndSymbol forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'*', Char
'_', Char
':', Char
'~'])
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
      )
  where
    stopChars :: String
stopChars = [Char
' ', Char
'\n']

-- slack accepts bold/italics modifiers
-- only at word boundary. for instance 'my_word'
-- doesn't trigger an italics section.
parseWhitespace :: Bool -> SlackParser SlackMsgItem
parseWhitespace :: Bool -> SlackParser SlackMsgItem
parseWhitespace Bool
True =
  Text -> SlackMsgItem
SlackMsgItemPlainText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
' ', Char
'\n'])
parseWhitespace Bool
False = Text -> SlackMsgItem
SlackMsgItemPlainText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
' '])

sectionEndSymbol :: Char -> SlackParser ()
sectionEndSymbol :: Char -> ParsecT MegaparsecError Text Identity ()
sectionEndSymbol Char
chr = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
chr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT MegaparsecError Text Identity ()
wordBoundary

parseCharDelimitedSection :: Char -> SlackParser [SlackMsgItem]
parseCharDelimitedSection :: Char -> ParsecT MegaparsecError Text Identity [SlackMsgItem]
parseCharDelimitedSection Char
chr =
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
chr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
someTill (Bool -> SlackParser SlackMsgItem
parseMessageItem Bool
False) (Char -> ParsecT MegaparsecError Text Identity ()
sectionEndSymbol Char
chr)

wordBoundary :: SlackParser ()
wordBoundary :: ParsecT MegaparsecError Text Identity ()
wordBoundary = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
' ', Char
'\n', Char
'*', Char
'_', Char
',', Char
'`', Char
'?', Char
'!', Char
':', Char
';', Char
'.']) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

parseBoldSection :: SlackParser SlackMsgItem
parseBoldSection :: SlackParser SlackMsgItem
parseBoldSection =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SlackMsgItem] -> SlackMsgItem
SlackMsgItemBoldSection (Char -> ParsecT MegaparsecError Text Identity [SlackMsgItem]
parseCharDelimitedSection Char
'*')

parseItalicsSection :: SlackParser SlackMsgItem
parseItalicsSection :: SlackParser SlackMsgItem
parseItalicsSection =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SlackMsgItem] -> SlackMsgItem
SlackMsgItemItalicsSection (Char -> ParsecT MegaparsecError Text Identity [SlackMsgItem]
parseCharDelimitedSection Char
'_')

parseStrikethroughSection :: SlackParser SlackMsgItem
parseStrikethroughSection :: SlackParser SlackMsgItem
parseStrikethroughSection =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SlackMsgItem] -> SlackMsgItem
SlackMsgItemStrikethroughSection (Char -> ParsecT MegaparsecError Text Identity [SlackMsgItem]
parseCharDelimitedSection Char
'~')

parseEmoticon :: SlackParser SlackMsgItem
parseEmoticon :: SlackParser SlackMsgItem
parseEmoticon =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> SlackMsgItem
SlackMsgItemEmoticon forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) forall a b. (a -> b) -> a -> b
$
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
someTill (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+') (Char -> ParsecT MegaparsecError Text Identity ()
sectionEndSymbol Char
':')

parseUserLink :: SlackParser SlackMsgItem
parseUserLink :: SlackParser SlackMsgItem
parseUserLink = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"<@")
  UserId
userId <- Text -> UserId
UserId forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'|', Char
'>'])
  let linkWithoutDesc :: SlackParser SlackMsgItem
linkWithoutDesc =
        forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'>'
          forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId -> Maybe Text -> SlackMsgItem
SlackMsgItemUserLink UserId
userId forall a. Maybe a
Nothing)
  let linkWithDesc :: SlackParser SlackMsgItem
linkWithDesc =
        forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'|'
          forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UserId -> Maybe Text -> SlackMsgItem
SlackMsgItemUserLink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure UserId
userId forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'>'])) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'>'))
  SlackParser SlackMsgItem
linkWithDesc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
linkWithoutDesc

parseLink :: SlackParser SlackMsgItem
parseLink :: SlackParser SlackMsgItem
parseLink = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'<')
  SlackUrl
url <- Text -> SlackUrl
SlackUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'|', Char
'>'])
  let linkWithoutDesc :: SlackParser SlackMsgItem
linkWithoutDesc =
        forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'>'
          forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> SlackUrl -> SlackMsgItem
SlackMsgItemLink (SlackUrl -> Text
unSlackUrl SlackUrl
url) SlackUrl
url)
  let linkWithDesc :: SlackParser SlackMsgItem
linkWithDesc =
        forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'|'
          forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> SlackUrl -> SlackMsgItem
SlackMsgItemLink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'>'])) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'>') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SlackUrl
url
  SlackParser SlackMsgItem
linkWithDesc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SlackParser SlackMsgItem
linkWithoutDesc

parseCode :: SlackParser SlackMsgItem
parseCode :: SlackParser SlackMsgItem
parseCode =
  Text -> SlackMsgItem
SlackMsgItemCodeSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"```" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"```"))

parseInlineCode :: SlackParser SlackMsgItem
parseInlineCode :: SlackParser SlackMsgItem
parseInlineCode =
  Text -> SlackMsgItem
SlackMsgItemInlineCodeSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'`' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'`']) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'`')

parseBlockQuote :: SlackParser SlackMsgItem
parseBlockQuote :: SlackParser SlackMsgItem
parseBlockQuote = [SlackMsgItem] -> SlackMsgItem
SlackMsgItemQuoted forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate [Text -> SlackMsgItem
SlackMsgItemPlainText Text
"<br/>"] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT MegaparsecError Text Identity [SlackMsgItem]
blockQuoteLine

blockQuoteLine :: SlackParser [SlackMsgItem]
blockQuoteLine :: ParsecT MegaparsecError Text Identity [SlackMsgItem]
blockQuoteLine =
  forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"&gt;"
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
' ')
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (Bool -> SlackParser SlackMsgItem
parseMessageItem Bool
False) (forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)

-- |
-- Convert the slack format for messages (markdown like, see
-- https://api.slack.com/docs/message-formatting ) to HTML.
messageToHtml ::
  -- | Renderers allow you to customize the message rendering.
  -- Give 'defaultHtmlRenderers' for a default implementation.
  HtmlRenderers ->
  -- | A function giving a user name for a user id. You can use 'Web.Slack.getUserDesc'
  (UserId -> Text) ->
  -- | A slack message to convert to HTML
  SlackMessageText ->
  -- | The HTML-formatted slack message
  Text
messageToHtml :: HtmlRenderers -> (UserId -> Text) -> SlackMessageText -> Text
messageToHtml HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc =
  HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [SlackMsgItem]
parseMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackMessageText -> Text
unSlackMessageText

messageToHtml' :: HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' :: HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlRenderers -> (UserId -> Text) -> SlackMsgItem -> Text
msgItemToHtml HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc) Text
""

data HtmlRenderers = HtmlRenderers
  { HtmlRenderers -> Text -> Text
emoticonRenderer :: Text -> Text
  }

defaultHtmlRenderers :: HtmlRenderers
defaultHtmlRenderers :: HtmlRenderers
defaultHtmlRenderers =
  HtmlRenderers
    { emoticonRenderer :: Text -> Text
emoticonRenderer = \Text
code -> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
code forall a. Semigroup a => a -> a -> a
<> Text
":"
    }

msgItemToHtml :: HtmlRenderers -> (UserId -> Text) -> SlackMsgItem -> Text
msgItemToHtml :: HtmlRenderers -> (UserId -> Text) -> SlackMsgItem -> Text
msgItemToHtml htmlRenderers :: HtmlRenderers
htmlRenderers@HtmlRenderers {Text -> Text
emoticonRenderer :: Text -> Text
emoticonRenderer :: HtmlRenderers -> Text -> Text
..} UserId -> Text
getUserDesc = \case
  SlackMsgItemPlainText Text
txt -> Text -> Text -> Text -> Text
T.replace Text
"\n" Text
"<br/>" Text
txt
  SlackMsgItemBoldSection [SlackMsgItem]
cts ->
    Text
"<b>" forall a. Semigroup a => a -> a -> a
<> HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc [SlackMsgItem]
cts forall a. Semigroup a => a -> a -> a
<> Text
"</b>"
  SlackMsgItemItalicsSection [SlackMsgItem]
cts ->
    Text
"<i>" forall a. Semigroup a => a -> a -> a
<> HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc [SlackMsgItem]
cts forall a. Semigroup a => a -> a -> a
<> Text
"</i>"
  SlackMsgItemStrikethroughSection [SlackMsgItem]
cts ->
    Text
"<strike>" forall a. Semigroup a => a -> a -> a
<> HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc [SlackMsgItem]
cts forall a. Semigroup a => a -> a -> a
<> Text
"</strike>"
  SlackMsgItemLink Text
txt SlackUrl
url ->
    Text
"<a href='" forall a. Semigroup a => a -> a -> a
<> SlackUrl -> Text
unSlackUrl SlackUrl
url forall a. Semigroup a => a -> a -> a
<> Text
"'>" forall a. Semigroup a => a -> a -> a
<> Text
txt forall a. Semigroup a => a -> a -> a
<> Text
"</a>"
  SlackMsgItemUserLink UserId
userId Maybe Text
mTxt -> Text
"@" forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe (UserId -> Text
getUserDesc UserId
userId) Maybe Text
mTxt
  SlackMsgItemEmoticon Text
code -> Text -> Text
emoticonRenderer Text
code
  SlackMsgItemInlineCodeSection Text
code -> Text
"<code>" forall a. Semigroup a => a -> a -> a
<> Text
code forall a. Semigroup a => a -> a -> a
<> Text
"</code>"
  SlackMsgItemCodeSection Text
code -> Text
"<pre>" forall a. Semigroup a => a -> a -> a
<> Text
code forall a. Semigroup a => a -> a -> a
<> Text
"</pre>"
  SlackMsgItemQuoted [SlackMsgItem]
items ->
    Text
"<blockquote>" forall a. Semigroup a => a -> a -> a
<> HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc [SlackMsgItem]
items forall a. Semigroup a => a -> a -> a
<> Text
"</blockquote>"