-- | 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 (..),
  )
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"

-- | Replaces all occurences of @\`\`\`@ with @\`\<zws\>\`\<zws\>\`@
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
"`")

-- | Replaces all occurences of @\`\`@ with @\`\<zws\>\`@
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
"`")

-- | Replaces all occurences of @\*\*@ with @\*\<zws\>\*@
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
"*")

-- | Replaces all occurences of @\~\~@ with @\~\<zws\>\~@
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
"~")

-- | Replaces all occurences of @\_\_@ with @\_\<zws\>\_@
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
"_")

-- | Replaces all occurences of @\|\|@ with @\|\<zws\>\|@
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
"|")

-- | Escape all discord formatting
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]

-- | Formats a lang and content into a codeblock
--
-- >>> codeblock "hs" "x = y"
-- "```hs\nx = y\n```"
--
-- Any codeblocks in the @content@ are escaped
codeblock :: L.Text -- ^ language
          -> L.Text -- ^ content
          -> 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)

-- | Formats an optional lang and content into a codeblock
--
-- Any codeblocks in the @content@ are escaped
codeblock' :: Maybe L.Text -- ^ language
          -> L.Text -- ^ content
          -> 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```"

-- | 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 :: 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
"``"

-- | Formats some text into it's bolded form
--
-- Any existing bolded text is escaped
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
"**"

-- | Formats some text into it's striked form
--
-- Any existing striked text is escaped
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
"~~"

-- | Formats some text into it's underlined form
--
-- Any existing underlined text is escaped
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
"__"

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

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

-- | Formats some text into it's spoilered form
--
-- Any existing spoilers are escaped
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
""

-- | Format a 'User' or 'Member' into the format of @username#discriminator@
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
">"

-- | Things that can be mentioned
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