Discord Bot

module Main where

import Calamity
    ( react,
      runBotIO,
      defaultIntents,
      invoke,
      EventType(MessageCreateEvt),
      ChannelRequest(CreateReaction, CreateMessage),
      RawEmoji(UnicodeEmoji),
      Token(BotToken) )
import Calamity.Cache.InMemory ( runCacheInMemory )
import Calamity.Commands ( useConstantPrefix )
import Calamity.Metrics.Noop ( runMetricsNoop )
import Control.Lens ((^.))
import Control.Monad ( void, when )
import Data.Default ()
import Data.Generics.Labels ()
import Data.Maybe ()
import Data.Text.Lazy (Text)
import Data.Text.Lazy.Encoding ( decodeUtf8 )
import qualified Data.Text.Lazy as T
import qualified Di
import DiPolysemy ( info, runDiToIO )
import qualified Polysemy as P
import System.Environment (getEnv)
import TextShow ()
import Di ( new, info )
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Set as Set

-- Get extract the words from a message
getMessageWords :: Text -> [Text]
getMessageWords = T.split (== ' ')

-- Check if any elements of a message are a swear word
anySwearWord :: Text -> Set.Set Text -> Bool
anySwearWord msg = listContainsSwearWord (getMessageWords msg)
  where
    listContainsSwearWord wordlist swearWords = any ((`isSwearWord` swearWords) . T.toUpper) wordlist
    isSwearWord = Set.member

main :: IO ()
main = do
  -- get set of swear words from file
  naughtyDict <- Set.fromList . map (T.toUpper . decodeUtf8) . L.words <$> L.readFile "assets/google_curse_wordlist.txt"
  -- get Token env variable
  token <- T.pack <$> getEnv "DISCORD"

  -- do bot things
  Di.new $ \di ->
    void
      . P.runFinal
      . P.embedToFinal @IO
      . runDiToIO di
      . runCacheInMemory
      . runMetricsNoop
      . useConstantPrefix "!"
      . runBotIO (BotToken token) defaultIntents
      $ do
        DiPolysemy.info @Text "Connection successful!"

        -- show the haskell pride
        react @'MessageCreateEvt $ \msg -> do
          when ("HASKELL" `T.isInfixOf` T.toUpper (msg ^. #content) && not (anySwearWord (msg ^. #content) naughtyDict)) $
            void . invoke $ CreateReaction msg msg (UnicodeEmoji "😄")

        -- discourage cursing
        react @'MessageCreateEvt $ \msg -> do
          when (anySwearWord (msg ^. #content) naughtyDict) $
            void . invoke $ CreateReaction msg msg (UnicodeEmoji "😡")