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))
import Data.Foldable (Foldable(foldl'))
zws :: IsString s => s
zws :: s
zws = String -> s
forall a. IsString a => String -> a
fromString String
"\x200b"
escapeCodeblocks :: L.Text -> L.Text
escapeCodeblocks :: Text -> Text
escapeCodeblocks = Text -> Text -> Text -> Text
L.replace Text
"```" (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 Int
3 Text
"`")
escapeCodelines :: L.Text -> L.Text
escapeCodelines :: Text -> Text
escapeCodelines = Text -> Text -> Text -> Text
L.replace Text
"``" (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 Int
2 Text
"`")
escapeBold :: L.Text -> L.Text
escapeBold :: Text -> Text
escapeBold = Text -> Text -> Text -> Text
L.replace Text
"**" (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 Int
2 Text
"*")
escapeStrike :: L.Text -> L.Text
escapeStrike :: Text -> Text
escapeStrike = Text -> Text -> Text -> Text
L.replace Text
"~~" (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 Int
2 Text
"~")
escapeUnderline :: L.Text -> L.Text
escapeUnderline :: Text -> Text
escapeUnderline = Text -> Text -> Text -> Text
L.replace Text
"__" (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 Int
2 Text
"_")
escapeSpoilers :: L.Text -> L.Text
escapeSpoilers :: Text -> Text
escapeSpoilers = Text -> Text -> Text -> Text
L.replace Text
"||" (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 Int
2 Text
"|")
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 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' Maybe Text
lang Text
content = Text
"```" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\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
<>
Text
"\n```"
codeline :: L.Text -> L.Text
codeline :: Text -> Text
codeline Text
content = Text
"``" 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
<> Text
"``"
bold :: L.Text -> L.Text
bold :: Text -> Text
bold Text
content = Text
"**" 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
<> Text
"**"
strike :: L.Text -> L.Text
strike :: Text -> Text
strike Text
content = Text
"~~" 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
<> Text
"~~"
underline :: L.Text -> L.Text
underline :: Text -> Text
underline Text
content = Text
"__" 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
<> Text
"__"
quote :: L.Text -> L.Text
quote :: Text -> Text
quote = (Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
quoteAll :: L.Text -> L.Text
quoteAll :: Text -> Text
quoteAll = (Text
">> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
spoiler :: L.Text -> L.Text
spoiler :: Text -> Text
spoiler Text
content = Text
"||" 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
<> Text
"||"
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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ifanim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" 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 -> 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
<> Text
">"
where ifanim :: Text
ifanim = if Bool
animated then Text
"a" else Text
""
displayUser :: (HasField' "username" a L.Text, HasField' "discriminator" a L.Text) => a -> L.Text
displayUser :: a -> Text
displayUser 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 -> 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 Text
tag Snowflake a
s = Text
"<" 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
<> Text
">"
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 Text
"@"
instance Mentionable (Snowflake Member) where
mention :: Snowflake Member -> Text
mention = Text -> Snowflake Member -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake Text
"@"
instance Mentionable (Snowflake Channel) where
mention :: Snowflake Channel -> Text
mention = Text -> Snowflake Channel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake Text
"#"
instance Mentionable (Snowflake TextChannel) where
mention :: Snowflake TextChannel -> Text
mention = Text -> Snowflake TextChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake Text
"#"
instance Mentionable (Snowflake VoiceChannel) where
mention :: Snowflake VoiceChannel -> Text
mention = Text -> Snowflake VoiceChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake Text
"#"
instance Mentionable (Snowflake Category) where
mention :: Snowflake Category -> Text
mention = Text -> Snowflake Category -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake Text
"#"
instance Mentionable (Snowflake GuildChannel) where
mention :: Snowflake GuildChannel -> Text
mention = Text -> Snowflake GuildChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake Text
"#"
instance Mentionable (Snowflake DMChannel) where
mention :: Snowflake DMChannel -> Text
mention = Text -> Snowflake DMChannel -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake Text
"#"
instance Mentionable (Snowflake Role) where
mention :: Snowflake Role -> Text
mention = Text -> Snowflake Role -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake Text
"@&"
instance Mentionable User where
mention :: User -> Text
mention = Text -> Snowflake User -> Text
forall a. Text -> Snowflake a -> Text
mentionSnowflake Text
"@" (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 Text
"@" (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 Text
"#" (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 Text
"#" (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 Text
"#" (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 Text
"#" (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 Text
"#" (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 Text
"#" (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 Text
"@&" (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