{-# 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
(Int -> SlackUrl -> ShowS)
-> (SlackUrl -> String) -> ([SlackUrl] -> ShowS) -> Show SlackUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlackUrl -> ShowS
showsPrec :: Int -> SlackUrl -> ShowS
$cshow :: SlackUrl -> String
show :: SlackUrl -> String
$cshowList :: [SlackUrl] -> ShowS
showList :: [SlackUrl] -> ShowS
Show, SlackUrl -> SlackUrl -> Bool
(SlackUrl -> SlackUrl -> Bool)
-> (SlackUrl -> SlackUrl -> Bool) -> Eq SlackUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlackUrl -> SlackUrl -> Bool
== :: SlackUrl -> SlackUrl -> Bool
$c/= :: SlackUrl -> SlackUrl -> Bool
/= :: 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
(Int -> SlackMsgItem -> ShowS)
-> (SlackMsgItem -> String)
-> ([SlackMsgItem] -> ShowS)
-> Show SlackMsgItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlackMsgItem -> ShowS
showsPrec :: Int -> SlackMsgItem -> ShowS
$cshow :: SlackMsgItem -> String
show :: SlackMsgItem -> String
$cshowList :: [SlackMsgItem] -> ShowS
showList :: [SlackMsgItem] -> ShowS
Show, SlackMsgItem -> SlackMsgItem -> Bool
(SlackMsgItem -> SlackMsgItem -> Bool)
-> (SlackMsgItem -> SlackMsgItem -> Bool) -> Eq SlackMsgItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlackMsgItem -> SlackMsgItem -> Bool
== :: SlackMsgItem -> SlackMsgItem -> Bool
$c/= :: SlackMsgItem -> SlackMsgItem -> Bool
/= :: 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 =
  [SlackMsgItem] -> Maybe [SlackMsgItem] -> [SlackMsgItem]
forall a. a -> Maybe a -> a
fromMaybe [Text -> SlackMsgItem
SlackMsgItemPlainText Text
input] (Maybe [SlackMsgItem] -> [SlackMsgItem])
-> Maybe [SlackMsgItem] -> [SlackMsgItem]
forall a b. (a -> b) -> a -> b
$
    Parsec MegaparsecError Text [SlackMsgItem]
-> Text -> Maybe [SlackMsgItem]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe (ParsecT MegaparsecError Text Identity SlackMsgItem
-> Parsec MegaparsecError Text [SlackMsgItem]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT MegaparsecError Text Identity SlackMsgItem
 -> Parsec MegaparsecError Text [SlackMsgItem])
-> ParsecT MegaparsecError Text Identity SlackMsgItem
-> Parsec MegaparsecError Text [SlackMsgItem]
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT MegaparsecError Text Identity SlackMsgItem
parseMessageItem Bool
True) Text
input

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

parsePlainText :: SlackParser SlackMsgItem
parsePlainText :: ParsecT MegaparsecError Text Identity SlackMsgItem
parsePlainText =
  Text -> SlackMsgItem
SlackMsgItemPlainText (Text -> SlackMsgItem)
-> (String -> Text) -> String -> SlackMsgItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    (String -> SlackMsgItem)
-> ParsecT MegaparsecError Text Identity String
-> ParsecT MegaparsecError Text Identity SlackMsgItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MegaparsecError Text Identity Char
-> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
someTill
      ([Token Text] -> ParsecT MegaparsecError Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
[Token Text]
stopChars)
      ( ParsecT MegaparsecError Text Identity (Token Text)
-> ParsecT MegaparsecError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT MegaparsecError Text Identity (Token Text)
-> ParsecT MegaparsecError Text Identity (Token Text)
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT MegaparsecError Text Identity (Token Text)
 -> ParsecT MegaparsecError Text Identity (Token Text))
-> ParsecT MegaparsecError Text Identity (Token Text)
-> ParsecT MegaparsecError Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ ParsecT MegaparsecError Text Identity (Token Text)
-> ParsecT MegaparsecError Text Identity (Token Text)
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT MegaparsecError Text Identity (Token Text)
 -> ParsecT MegaparsecError Text Identity (Token Text))
-> ParsecT MegaparsecError Text Identity (Token Text)
-> ParsecT MegaparsecError Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT MegaparsecError Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token Text]
stopChars)
          ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT MegaparsecError Text Identity ()
 -> ParsecT MegaparsecError Text Identity ())
-> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a b. (a -> b) -> a -> b
$ [ParsecT MegaparsecError Text Identity ()]
-> ParsecT MegaparsecError Text Identity ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT MegaparsecError Text Identity ()]
 -> ParsecT MegaparsecError Text Identity ())
-> [ParsecT MegaparsecError Text Identity ()]
-> ParsecT MegaparsecError Text Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT MegaparsecError Text Identity ()
sectionEndSymbol (Char -> ParsecT MegaparsecError Text Identity ())
-> String -> [ParsecT MegaparsecError Text Identity ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'*', Char
'_', Char
':', Char
'~'])
          ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT MegaparsecError Text Identity ()
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 -> ParsecT MegaparsecError Text Identity SlackMsgItem
parseWhitespace Bool
True =
  Text -> SlackMsgItem
SlackMsgItemPlainText (Text -> SlackMsgItem)
-> (String -> Text) -> String -> SlackMsgItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> SlackMsgItem)
-> ParsecT MegaparsecError Text Identity String
-> ParsecT MegaparsecError Text Identity SlackMsgItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MegaparsecError Text Identity Char
-> ParsecT MegaparsecError Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Token Text] -> ParsecT MegaparsecError Text Identity (Token Text)
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 (Text -> SlackMsgItem)
-> (String -> Text) -> String -> SlackMsgItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> SlackMsgItem)
-> ParsecT MegaparsecError Text Identity String
-> ParsecT MegaparsecError Text Identity SlackMsgItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MegaparsecError Text Identity Char
-> ParsecT MegaparsecError Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Token Text] -> ParsecT MegaparsecError Text Identity (Token Text)
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 = ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT MegaparsecError Text Identity ()
 -> ParsecT MegaparsecError Text Identity ())
-> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT MegaparsecError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
chr ParsecT MegaparsecError Text Identity Char
-> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a b.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity b
-> ParsecT MegaparsecError Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
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 -> Parsec MegaparsecError Text [SlackMsgItem]
parseCharDelimitedSection Char
chr =
  Token Text -> ParsecT MegaparsecError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
chr ParsecT MegaparsecError Text Identity Char
-> Parsec MegaparsecError Text [SlackMsgItem]
-> Parsec MegaparsecError Text [SlackMsgItem]
forall a b.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity b
-> ParsecT MegaparsecError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MegaparsecError Text Identity SlackMsgItem
-> ParsecT MegaparsecError Text Identity ()
-> Parsec MegaparsecError Text [SlackMsgItem]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
someTill (Bool -> ParsecT MegaparsecError Text Identity SlackMsgItem
parseMessageItem Bool
False) (Char -> ParsecT MegaparsecError Text Identity ()
sectionEndSymbol Char
chr)

wordBoundary :: SlackParser ()
wordBoundary :: ParsecT MegaparsecError Text Identity ()
wordBoundary = ParsecT MegaparsecError Text Identity (Token Text)
-> ParsecT MegaparsecError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Token Text] -> ParsecT MegaparsecError Text Identity (Token Text)
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
'.']) ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MegaparsecError Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

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

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

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

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

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

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

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

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

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

blockQuoteLine :: SlackParser [SlackMsgItem]
blockQuoteLine :: Parsec MegaparsecError Text [SlackMsgItem]
blockQuoteLine =
  Tokens Text -> ParsecT MegaparsecError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"&gt;"
    ParsecT MegaparsecError Text Identity (Tokens Text)
-> ParsecT MegaparsecError Text Identity (Maybe Char)
-> ParsecT MegaparsecError Text Identity (Maybe Char)
forall a b.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity b
-> ParsecT MegaparsecError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MegaparsecError Text Identity Char
-> ParsecT MegaparsecError Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT MegaparsecError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' ')
    ParsecT MegaparsecError Text Identity (Maybe Char)
-> Parsec MegaparsecError Text [SlackMsgItem]
-> Parsec MegaparsecError Text [SlackMsgItem]
forall a b.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity b
-> ParsecT MegaparsecError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MegaparsecError Text Identity SlackMsgItem
-> ParsecT MegaparsecError Text Identity ()
-> Parsec MegaparsecError Text [SlackMsgItem]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (Bool -> ParsecT MegaparsecError Text Identity SlackMsgItem
parseMessageItem Bool
False) (ParsecT MegaparsecError Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
-> ParsecT MegaparsecError Text Identity ()
forall a.
ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
-> ParsecT MegaparsecError Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MegaparsecError Text Identity Char
-> ParsecT MegaparsecError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT MegaparsecError Text Identity Char
ParsecT MegaparsecError Text Identity (Token Text)
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 ([SlackMsgItem] -> Text)
-> (SlackMessageText -> [SlackMsgItem]) -> SlackMessageText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [SlackMsgItem]
parseMessage (Text -> [SlackMsgItem])
-> (SlackMessageText -> Text) -> SlackMessageText -> [SlackMsgItem]
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 = (SlackMsgItem -> Text -> Text) -> Text -> [SlackMsgItem] -> Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text)
-> (SlackMsgItem -> Text) -> SlackMsgItem -> Text -> Text
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
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code Text -> Text -> Text
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 :: HtmlRenderers -> Text -> Text
emoticonRenderer :: Text -> Text
..} UserId -> Text
getUserDesc = \case
  SlackMsgItemPlainText Text
txt -> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\n" Text
"<br/>" Text
txt
  SlackMsgItemBoldSection [SlackMsgItem]
cts ->
    Text
"<b>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc [SlackMsgItem]
cts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</b>"
  SlackMsgItemItalicsSection [SlackMsgItem]
cts ->
    Text
"<i>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc [SlackMsgItem]
cts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</i>"
  SlackMsgItemStrikethroughSection [SlackMsgItem]
cts ->
    Text
"<strike>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc [SlackMsgItem]
cts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</strike>"
  SlackMsgItemLink Text
txt SlackUrl
url ->
    Text
"<a href='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlackUrl -> Text
unSlackUrl SlackUrl
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</a>"
  SlackMsgItemUserLink UserId
userId Maybe Text
mTxt -> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
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>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</code>"
  SlackMsgItemCodeSection Text
code -> Text
"<pre>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</pre>"
  SlackMsgItemQuoted [SlackMsgItem]
items ->
    Text
"<blockquote>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text
messageToHtml' HtmlRenderers
htmlRenderers UserId -> Text
getUserDesc [SlackMsgItem]
items Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</blockquote>"