-- | Things for formatting things
module Calamity.Utils.Message (
  codeblock,
  codeblock',
  codeline,
  escapeCodeblocks,
  escapeCodelines,
  escapeBold,
  escapeStrike,
  escapeUnderline,
  escapeSpoilers,
  escapeFormatting,
  bold,
  strike,
  underline,
  quote,
  quoteAll,
  spoiler,
  zws,
  fmtEmoji,
  displayUser,
  Mentionable (..),
  asReference,
) where

import Calamity.Types.Model.Channel (
  Category,
  Channel,
  DMChannel,
  GuildChannel,
  Message,
  MessageReference(MessageReference),
  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.Foldable (Foldable (foldl'))
import Data.Generics.Product.Fields
import Data.Maybe (fromMaybe)
import Data.String (IsString, fromString)
import qualified Data.Text as T
import TextShow (TextShow (showt))

zws :: IsString s => s
zws :: s
zws = String -> s
forall a. IsString a => String -> a
fromString String
"\x200b"

-- | Replaces all occurences of @\`\`\`@ with @\`\<zws\>\`\<zws\>\`@
escapeCodeblocks :: T.Text -> T.Text
escapeCodeblocks :: Text -> Text
escapeCodeblocks = Text -> Text -> Text -> Text
T.replace Text
"```" (Text -> [Text] -> Text
T.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
"`")

-- | Replaces all occurences of @\`\`@ with @\`\<zws\>\`@
escapeCodelines :: T.Text -> T.Text
escapeCodelines :: Text -> Text
escapeCodelines = Text -> Text -> Text -> Text
T.replace Text
"``" (Text -> [Text] -> Text
T.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
"`")

-- | Replaces all occurences of @\*\*@ with @\*\<zws\>\*@
escapeBold :: T.Text -> T.Text
escapeBold :: Text -> Text
escapeBold = Text -> Text -> Text -> Text
T.replace Text
"**" (Text -> [Text] -> Text
T.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
"*")

-- | Replaces all occurences of @\~\~@ with @\~\<zws\>\~@
escapeStrike :: T.Text -> T.Text
escapeStrike :: Text -> Text
escapeStrike = Text -> Text -> Text -> Text
T.replace Text
"~~" (Text -> [Text] -> Text
T.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
"~")

-- | Replaces all occurences of @\_\_@ with @\_\<zws\>\_@
escapeUnderline :: T.Text -> T.Text
escapeUnderline :: Text -> Text
escapeUnderline = Text -> Text -> Text -> Text
T.replace Text
"__" (Text -> [Text] -> Text
T.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
"_")

-- | Replaces all occurences of @\|\|@ with @\|\<zws\>\|@
escapeSpoilers :: T.Text -> T.Text
escapeSpoilers :: Text -> Text
escapeSpoilers = Text -> Text -> Text -> Text
T.replace Text
"||" (Text -> [Text] -> Text
T.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
"|")

-- | Escape all discord formatting
escapeFormatting :: T.Text -> T.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]

{- | Formats a lang and content into a codeblock

 >>> codeblock "hs" "x = y"
 "```hs\nx = y\n```"

 Any codeblocks in the @content@ are escaped
-}
codeblock ::
  -- | language
  T.Text ->
  -- | content
  T.Text ->
  T.Text
codeblock :: Text -> Text -> Text
codeblock Text
lang = Maybe Text -> Text -> Text
codeblock' (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lang)

{- | Formats an optional lang and content into a codeblock

 Any codeblocks in the @content@ are escaped
-}
codeblock' ::
  -- | language
  Maybe T.Text ->
  -- | content
  T.Text ->
  T.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```"

{- | Formats some content into a code line

 This always uses @``@ code lines as they can be escaped

 Any code lines in the content are escaped
-}
codeline :: T.Text -> T.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
"``"

{- | Formats some text into its bolded form

 Any existing bolded text is escaped
-}
bold :: T.Text -> T.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
"**"

{- | Formats some text into its striked form

 Any existing striked text is escaped
-}
strike :: T.Text -> T.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
"~~"

{- | Formats some text into its underlined form

 Any existing underlined text is escaped
-}
underline :: T.Text -> T.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
"__"

-- | Quotes a section of text
quote :: T.Text -> T.Text
quote :: Text -> Text
quote = (Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

-- | Quotes all remaining text
quoteAll :: T.Text -> T.Text
quoteAll :: Text -> Text
quoteAll = (Text
">> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

{- | Formats some text into its spoilered form

 Any existing spoilers are escaped
-}
spoiler :: T.Text -> T.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 -> T.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
showt 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
""

-- | Format a 'User' or 'Member' into the format of @username#discriminator@
displayUser :: (HasField' "username" a T.Text, HasField' "discriminator" a T.Text) => a -> T.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 :: T.Text -> Snowflake a -> T.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
showt Snowflake a
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"

-- | Things that can be mentioned
class Mentionable a where
  mention :: a -> T.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

-- | Turn a regular 'Message' into a 'MessageReference'
asReference :: Message
  -- ^ The message to reply to
  -> Bool
  -- ^ If discord should error when replying to deleted messages
  -> MessageReference
asReference :: Message -> Bool -> MessageReference
asReference Message
msg Bool
failIfNotExists =
  Maybe (Snowflake Message)
-> Maybe (Snowflake Channel)
-> Maybe (Snowflake Guild)
-> Bool
-> MessageReference
MessageReference
    (Snowflake Message -> Maybe (Snowflake Message)
forall a. a -> Maybe a
Just (Snowflake Message -> Maybe (Snowflake Message))
-> Snowflake Message -> Maybe (Snowflake Message)
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake Message
forall b a. HasID b a => a -> Snowflake b
getID @Message Message
msg)
    (Snowflake Channel -> Maybe (Snowflake Channel)
forall a. a -> Maybe a
Just (Snowflake Channel -> Maybe (Snowflake Channel))
-> Snowflake Channel -> Maybe (Snowflake Channel)
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID @Channel Message
msg)
    (Message
msg Message
-> Getting
     (Maybe (Snowflake Guild)) Message (Maybe (Snowflake Guild))
-> Maybe (Snowflake Guild)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "guildID"
  (Getting
     (Maybe (Snowflake Guild)) Message (Maybe (Snowflake Guild)))
Getting (Maybe (Snowflake Guild)) Message (Maybe (Snowflake Guild))
#guildID)
    Bool
failIfNotExists