-- | 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 Data.Foldable (Foldable (foldl'))
import Data.Maybe (fromMaybe)
import Data.String (IsString, fromString)
import Data.Text qualified as T
import GHC.Records (HasField (getField))
import Optics
import TextShow (TextShow (showt))

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

-- | Replaces all occurences of @\`\`\`@ with @\`\<zws\>\`\<zws\>\`@
escapeCodeblocks :: T.Text -> T.Text
escapeCodeblocks :: Text -> Text
escapeCodeblocks = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"```" (Text -> [Text] -> Text
T.intercalate Text
forall (s :: OpticKind). IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall (a :: OpticKind). Int -> a -> [a]
replicate Int
3 Text
"`")

-- | Replaces all occurences of @\`\`@ with @\`\<zws\>\`@
escapeCodelines :: T.Text -> T.Text
escapeCodelines :: Text -> Text
escapeCodelines = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"``" (Text -> [Text] -> Text
T.intercalate Text
forall (s :: OpticKind). IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall (a :: OpticKind). Int -> a -> [a]
replicate Int
2 Text
"`")

-- | Replaces all occurences of @\*\*@ with @\*\<zws\>\*@
escapeBold :: T.Text -> T.Text
escapeBold :: Text -> Text
escapeBold = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"**" (Text -> [Text] -> Text
T.intercalate Text
forall (s :: OpticKind). IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall (a :: OpticKind). Int -> a -> [a]
replicate Int
2 Text
"*")

-- | Replaces all occurences of @\~\~@ with @\~\<zws\>\~@
escapeStrike :: T.Text -> T.Text
escapeStrike :: Text -> Text
escapeStrike = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"~~" (Text -> [Text] -> Text
T.intercalate Text
forall (s :: OpticKind). IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall (a :: OpticKind). Int -> a -> [a]
replicate Int
2 Text
"~")

-- | Replaces all occurences of @\_\_@ with @\_\<zws\>\_@
escapeUnderline :: T.Text -> T.Text
escapeUnderline :: Text -> Text
escapeUnderline = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"__" (Text -> [Text] -> Text
T.intercalate Text
forall (s :: OpticKind). IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall (a :: OpticKind). Int -> a -> [a]
replicate Int
2 Text
"_")

-- | Replaces all occurences of @\|\|@ with @\|\<zws\>\|@
escapeSpoilers :: T.Text -> T.Text
escapeSpoilers :: Text -> Text
escapeSpoilers = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"||" (Text -> [Text] -> Text
T.intercalate Text
forall (s :: OpticKind). IsString s => s
zws ([Text] -> Text) -> [Text] -> Text
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall (a :: OpticKind). 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 (b :: OpticKind) (a :: OpticKind).
(b -> a -> b) -> b -> [a] -> b
forall (t :: OpticKind -> OpticKind) (b :: OpticKind)
       (a :: OpticKind).
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
(.) Text -> Text
forall (a :: OpticKind). 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 :: OpticKind). 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 :: OpticKind). Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
lang
    Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"\n"
    Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text -> Text
escapeCodeblocks Text
content
    Text -> Text -> Text
forall (a :: OpticKind). 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 :: OpticKind). Semigroup a => a -> a -> a
<> Text -> Text
escapeCodelines Text
content Text -> Text -> Text
forall (a :: OpticKind). 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 :: OpticKind). Semigroup a => a -> a -> a
<> Text -> Text
escapeBold Text
content Text -> Text -> Text
forall (a :: OpticKind). 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 :: OpticKind). Semigroup a => a -> a -> a
<> Text -> Text
escapeStrike Text
content Text -> Text -> Text
forall (a :: OpticKind). 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 :: OpticKind). Semigroup a => a -> a -> a
<> Text -> Text
escapeUnderline Text
content Text -> Text -> Text
forall (a :: OpticKind). 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 :: OpticKind). Semigroup a => a -> a -> a
<>)

-- | Quotes all remaining text
quoteAll :: T.Text -> T.Text
quoteAll :: Text -> Text
quoteAll = (Text
">> " Text -> Text -> Text
forall (a :: OpticKind). 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 :: OpticKind). Semigroup a => a -> a -> a
<> Text -> Text
escapeSpoilers Text
content Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"||"

fmtEmoji :: Emoji -> T.Text
fmtEmoji :: Emoji -> Text
fmtEmoji Emoji {Snowflake Emoji
id :: Snowflake Emoji
$sel:id:Emoji :: Emoji -> Snowflake Emoji
id, Text
name :: Text
$sel:name:Emoji :: Emoji -> Text
name, Bool
animated :: Bool
$sel:animated:Emoji :: Emoji -> Bool
animated} = Text
"<" Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
ifanim Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Snowflake Emoji -> Text
forall (a :: OpticKind). TextShow a => a -> Text
showt Snowflake Emoji
id Text -> Text -> Text
forall (a :: OpticKind). 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 :: forall (a :: OpticKind).
(HasField "username" a Text, HasField "discriminator" a Text) =>
a -> Text
displayUser a
u = forall {k :: OpticKind} (x :: k) (r :: OpticKind) (a :: OpticKind).
HasField x r a =>
r -> a
forall (x :: Symbol) (r :: OpticKind) (a :: OpticKind).
HasField x r a =>
r -> a
getField @"username" a
u Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall {k :: OpticKind} (x :: k) (r :: OpticKind) (a :: OpticKind).
HasField x r a =>
r -> a
forall (x :: Symbol) (r :: OpticKind) (a :: OpticKind).
HasField x r a =>
r -> a
getField @"discriminator" a
u

mentionSnowflake :: T.Text -> Snowflake a -> T.Text
mentionSnowflake :: forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
tag Snowflake a
s = Text
"<" Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
tag Text -> Text -> Text
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Snowflake a -> Text
forall (a :: OpticKind). TextShow a => a -> Text
showt Snowflake a
s Text -> Text -> Text
forall (a :: OpticKind). 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 :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"@"

instance Mentionable (Snowflake Member) where
  mention :: Snowflake Member -> Text
mention = Text -> Snowflake Member -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"@"

instance Mentionable (Snowflake Channel) where
  mention :: Snowflake Channel -> Text
mention = Text -> Snowflake Channel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#"

instance Mentionable (Snowflake TextChannel) where
  mention :: Snowflake TextChannel -> Text
mention = Text -> Snowflake TextChannel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#"

instance Mentionable (Snowflake VoiceChannel) where
  mention :: Snowflake VoiceChannel -> Text
mention = Text -> Snowflake VoiceChannel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#"

instance Mentionable (Snowflake Category) where
  mention :: Snowflake Category -> Text
mention = Text -> Snowflake Category -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#"

instance Mentionable (Snowflake GuildChannel) where
  mention :: Snowflake GuildChannel -> Text
mention = Text -> Snowflake GuildChannel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#"

instance Mentionable (Snowflake DMChannel) where
  mention :: Snowflake DMChannel -> Text
mention = Text -> Snowflake DMChannel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#"

instance Mentionable (Snowflake Role) where
  mention :: Snowflake Role -> Text
mention = Text -> Snowflake Role -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"@&"

instance Mentionable User where
  mention :: User -> Text
mention = Text -> Snowflake User -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"@" (Snowflake User -> Text)
-> (User -> Snowflake User) -> User -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User

instance Mentionable Member where
  mention :: Member -> Text
mention = Text -> Snowflake Member -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"@" (Snowflake Member -> Text)
-> (Member -> Snowflake Member) -> Member -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Member

instance Mentionable Channel where
  mention :: Channel -> Text
mention = Text -> Snowflake Channel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#" (Snowflake Channel -> Text)
-> (Channel -> Snowflake Channel) -> Channel -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Channel

instance Mentionable TextChannel where
  mention :: TextChannel -> Text
mention = Text -> Snowflake TextChannel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#" (Snowflake TextChannel -> Text)
-> (TextChannel -> Snowflake TextChannel) -> TextChannel -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @TextChannel

instance Mentionable VoiceChannel where
  mention :: VoiceChannel -> Text
mention = Text -> Snowflake VoiceChannel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#" (Snowflake VoiceChannel -> Text)
-> (VoiceChannel -> Snowflake VoiceChannel) -> VoiceChannel -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @VoiceChannel

instance Mentionable Category where
  mention :: Category -> Text
mention = Text -> Snowflake Category -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#" (Snowflake Category -> Text)
-> (Category -> Snowflake Category) -> Category -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Category

instance Mentionable GuildChannel where
  mention :: GuildChannel -> Text
mention = Text -> Snowflake GuildChannel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#" (Snowflake GuildChannel -> Text)
-> (GuildChannel -> Snowflake GuildChannel) -> GuildChannel -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @GuildChannel

instance Mentionable DMChannel where
  mention :: DMChannel -> Text
mention = Text -> Snowflake DMChannel -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"#" (Snowflake DMChannel -> Text)
-> (DMChannel -> Snowflake DMChannel) -> DMChannel -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @DMChannel

instance Mentionable Role where
  mention :: Role -> Text
mention = Text -> Snowflake Role -> Text
forall (a :: OpticKind). Text -> Snowflake a -> Text
mentionSnowflake Text
"@&" (Snowflake Role -> Text)
-> (Role -> Snowflake Role) -> Role -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Role

-- | Turn a regular 'Message' into a 'MessageReference'
asReference ::
  -- | The message to reply to
  Message ->
  -- | If discord should error when replying to deleted messages
  Bool ->
  MessageReference
asReference :: Message -> Bool -> MessageReference
asReference Message
msg =
  Maybe (Snowflake Message)
-> Maybe (Snowflake Channel)
-> Maybe (Snowflake Guild)
-> Bool
-> MessageReference
MessageReference
    (Snowflake Message -> Maybe (Snowflake Message)
forall (a :: OpticKind). a -> Maybe a
Just (Snowflake Message -> Maybe (Snowflake Message))
-> Snowflake Message -> Maybe (Snowflake Message)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message Message
msg)
    (Snowflake Channel -> Maybe (Snowflake Channel)
forall (a :: OpticKind). a -> Maybe a
Just (Snowflake Channel -> Maybe (Snowflake Channel))
-> Snowflake Channel -> Maybe (Snowflake Channel)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Channel Message
msg)
    (Message
msg Message
-> Optic' A_Lens NoIx Message (Maybe (Snowflake Guild))
-> Maybe (Snowflake Guild)
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Message (Maybe (Snowflake Guild))
#guildID)