module Calamity.Utils.Message
( codeblock,
codeblock',
codeline,
escapeCodeblocks,
escapeCodelines,
escapeBold,
escapeStrike,
escapeUnderline,
escapeSpoilers,
escapeFormatting,
bold,
strike,
underline,
quote,
quoteAll,
spoiler,
zws,
fmtEmoji,
displayUser,
Mentionable (..),
)
where
import Calamity.Types.Model.Channel (Category, Channel, DMChannel, GuildChannel, TextChannel, VoiceChannel)
import Calamity.Types.Model.Guild (Emoji(..), Member, Role)
import Calamity.Types.Model.User (User)
import Calamity.Types.Snowflake
import Control.Lens
import Data.Generics.Product.Fields
import Data.Maybe (fromMaybe)
import Data.String (IsString, fromString)
import qualified Data.Text.Lazy as L
import TextShow (TextShow (showtl))
zws :: IsString s => s
zws :: s
zws = String -> s
forall a. IsString a => String -> a
fromString "\x200b"
escapeCodeblocks :: L.Text -> L.Text
escapeCodeblocks :: Text -> Text
escapeCodeblocks = Text -> Text -> Text -> Text
L.replace "```" (Text -> [Text] -> Text
L.intercalate Text
forall s. IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate 3 "`")
escapeCodelines :: L.Text -> L.Text
escapeCodelines :: Text -> Text
escapeCodelines = Text -> Text -> Text -> Text
L.replace "``" (Text -> [Text] -> Text
L.intercalate Text
forall s. IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate 2 "`")
escapeBold :: L.Text -> L.Text
escapeBold :: Text -> Text
escapeBold = Text -> Text -> Text -> Text
L.replace "**" (Text -> [Text] -> Text
L.intercalate Text
forall s. IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate 2 "*")
escapeStrike :: L.Text -> L.Text
escapeStrike :: Text -> Text
escapeStrike = Text -> Text -> Text -> Text
L.replace "~~" (Text -> [Text] -> Text
L.intercalate Text
forall s. IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate 2 "~")
escapeUnderline :: L.Text -> L.Text
escapeUnderline :: Text -> Text
escapeUnderline = Text -> Text -> Text -> Text
L.replace "__" (Text -> [Text] -> Text
L.intercalate Text
forall s. IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate 2 "_")
escapeSpoilers :: L.Text -> L.Text
escapeSpoilers :: Text -> Text
escapeSpoilers = Text -> Text -> Text -> Text
L.replace "||" (Text -> [Text] -> Text
L.intercalate Text
forall s. IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate 2 "|")
escapeFormatting :: L.Text -> L.Text
escapeFormatting :: Text -> Text
escapeFormatting = ((Text -> Text) -> (Text -> Text) -> Text -> Text)
-> (Text -> Text) -> [Text -> Text] -> Text -> Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Text -> Text
forall a. a -> a
Prelude.id [Text -> Text
escapeCodelines, Text -> Text
escapeCodeblocks, Text -> Text
escapeBold, Text -> Text
escapeStrike, Text -> Text
escapeUnderline, Text -> Text
escapeSpoilers, Text -> Text
escapeFormatting]
codeblock :: L.Text
-> L.Text
-> L.Text
codeblock :: Text -> Text -> Text
codeblock lang :: Text
lang = Maybe Text -> Text -> Text
codeblock' (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lang)
codeblock' :: Maybe L.Text
-> L.Text
-> L.Text
codeblock' :: Maybe Text -> Text -> Text
codeblock' lang :: Maybe Text
lang content :: Text
content = "```" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" Maybe Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Text
escapeCodeblocks Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
"\n```"
codeline :: L.Text -> L.Text
codeline :: Text -> Text
codeline content :: Text
content = "``" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeCodelines Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "``"
bold :: L.Text -> L.Text
bold :: Text -> Text
bold content :: Text
content = "**" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeBold Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "**"
strike :: L.Text -> L.Text
strike :: Text -> Text
strike content :: Text
content = "~~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStrike Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "~~"
underline :: L.Text -> L.Text
underline :: Text -> Text
underline content :: Text
content = "__" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeUnderline Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "__"
quote :: L.Text -> L.Text
quote :: Text -> Text
quote = ("> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
quoteAll :: L.Text -> L.Text
quoteAll :: Text -> Text
quoteAll = (">> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
spoiler :: L.Text -> L.Text
spoiler :: Text -> Text
spoiler content :: Text
content = "||" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeSpoilers Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "||"
fmtEmoji :: Emoji -> L.Text
fmtEmoji :: Emoji -> Text
fmtEmoji Emoji { Snowflake Emoji
$sel:id:Emoji :: Emoji -> Snowflake Emoji
id :: Snowflake Emoji
id, Text
$sel:name:Emoji :: Emoji -> Text
name :: Text
name, Bool
$sel:animated:Emoji :: Emoji -> Bool
animated :: Bool
animated } = "<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ifanim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Snowflake Emoji -> Text
forall a. TextShow a => a -> Text
showtl Snowflake Emoji
id Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">"
where ifanim :: Text
ifanim = if Bool
animated then "a" else ""
displayUser :: (HasField' "username" a L.Text, HasField' "discriminator" a L.Text) => a -> L.Text
displayUser :: a -> Text
displayUser u :: a
u = (a
u a -> Getting Text a Text -> Text
forall s a. s -> Getting a s a -> a
^. forall s a. HasField' "username" s a => Lens s s a a
forall (field :: Symbol) s a. HasField' field s a => Lens s s a a
field' @"username") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (a
u a -> Getting Text a Text -> Text
forall s a. s -> Getting a s a -> a
^. forall s a. HasField' "discriminator" s a => Lens s s a a
forall (field :: Symbol) s a. HasField' field s a => Lens s s a a
field' @"discriminator")
mentionSnowflake :: L.Text -> Snowflake a -> L.Text
mentionSnowflake :: Text -> Snowflake a -> Text
mentionSnowflake tag :: Text
tag s :: Snowflake a
s = "<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Snowflake a -> Text
forall a. TextShow a => a -> Text
showtl Snowflake a
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">"
class Mentionable a where
mention :: a -> L.Text
instance Mentionable (Snowflake User) where
mention :: Snowflake User -> Text
mention = Text -> Snowflake User -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "@"
instance Mentionable (Snowflake Member) where
mention :: Snowflake Member -> Text
mention = Text -> Snowflake Member -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "@"
instance Mentionable (Snowflake Channel) where
mention :: Snowflake Channel -> Text
mention = Text -> Snowflake Channel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#"
instance Mentionable (Snowflake TextChannel) where
mention :: Snowflake TextChannel -> Text
mention = Text -> Snowflake TextChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#"
instance Mentionable (Snowflake VoiceChannel) where
mention :: Snowflake VoiceChannel -> Text
mention = Text -> Snowflake VoiceChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#"
instance Mentionable (Snowflake Category) where
mention :: Snowflake Category -> Text
mention = Text -> Snowflake Category -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#"
instance Mentionable (Snowflake GuildChannel) where
mention :: Snowflake GuildChannel -> Text
mention = Text -> Snowflake GuildChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#"
instance Mentionable (Snowflake DMChannel) where
mention :: Snowflake DMChannel -> Text
mention = Text -> Snowflake DMChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#"
instance Mentionable (Snowflake Role) where
mention :: Snowflake Role -> Text
mention = Text -> Snowflake Role -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "@&"
instance Mentionable User where
mention :: User -> Text
mention = Text -> Snowflake User -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "@" (Snowflake User -> Text)
-> (User -> Snowflake User) -> User -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasID User a => a -> Snowflake User
forall b a. HasID b a => a -> Snowflake b
getID @User
instance Mentionable Member where
mention :: Member -> Text
mention = Text -> Snowflake Member -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "@" (Snowflake Member -> Text)
-> (Member -> Snowflake Member) -> Member -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasID Member a => a -> Snowflake Member
forall b a. HasID b a => a -> Snowflake b
getID @Member
instance Mentionable Channel where
mention :: Channel -> Text
mention = Text -> Snowflake Channel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#" (Snowflake Channel -> Text)
-> (Channel -> Snowflake Channel) -> Channel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasID Channel a => a -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID @Channel
instance Mentionable TextChannel where
mention :: TextChannel -> Text
mention = Text -> Snowflake TextChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#" (Snowflake TextChannel -> Text)
-> (TextChannel -> Snowflake TextChannel) -> TextChannel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasID TextChannel a => a -> Snowflake TextChannel
forall b a. HasID b a => a -> Snowflake b
getID @TextChannel
instance Mentionable VoiceChannel where
mention :: VoiceChannel -> Text
mention = Text -> Snowflake VoiceChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#" (Snowflake VoiceChannel -> Text)
-> (VoiceChannel -> Snowflake VoiceChannel) -> VoiceChannel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasID VoiceChannel a => a -> Snowflake VoiceChannel
forall b a. HasID b a => a -> Snowflake b
getID @VoiceChannel
instance Mentionable Category where
mention :: Category -> Text
mention = Text -> Snowflake Category -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#" (Snowflake Category -> Text)
-> (Category -> Snowflake Category) -> Category -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasID Category a => a -> Snowflake Category
forall b a. HasID b a => a -> Snowflake b
getID @Category
instance Mentionable GuildChannel where
mention :: GuildChannel -> Text
mention = Text -> Snowflake GuildChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#" (Snowflake GuildChannel -> Text)
-> (GuildChannel -> Snowflake GuildChannel) -> GuildChannel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasID GuildChannel a => a -> Snowflake GuildChannel
forall b a. HasID b a => a -> Snowflake b
getID @GuildChannel
instance Mentionable DMChannel where
mention :: DMChannel -> Text
mention = Text -> Snowflake DMChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "#" (Snowflake DMChannel -> Text)
-> (DMChannel -> Snowflake DMChannel) -> DMChannel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasID DMChannel a => a -> Snowflake DMChannel
forall b a. HasID b a => a -> Snowflake b
getID @DMChannel
instance Mentionable Role where
mention :: Role -> Text
mention = Text -> Snowflake Role -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake "@&" (Snowflake Role -> Text)
-> (Role -> Snowflake Role) -> Role -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasID Role a => a -> Snowflake Role
forall b a. HasID b a => a -> Snowflake b
getID @Role