hs-source-dirs:   app

    hs-source-dirs:   app/cli
    default-language: Haskell2010
executable deckvine-discord
    import: warnings
    main-is: Main.hs
    build-depends:
        base ^>=4.18.1.0,
        mtg,
        text,
        discord-haskell,
        mtl,
        transformers,
    hs-source-dirs: app/discord

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Main where
import Data.Foldable
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as TIO
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Trans.Maybe
import System.Environment
import Discord
import qualified Discord.Requests as Request
import Discord.Types
data AppConfig = AppConfig
    { botToken :: Text
    , channels :: [Text]
    }
defaultConfig :: AppConfig
defaultConfig =
    AppConfig
        { botToken = mempty
        , channels = ["bot-testing"]
        }
getBotToken :: MaybeT IO Text
getBotToken = do
    token <- liftIO $ lookupEnv "DECKVINE_DISCORD_TOKEN"
    MaybeT . return $ fmap Text.pack token
getAppConfig :: MaybeT IO AppConfig
getAppConfig = do
    botToken <- getBotToken
    MaybeT . return $ Just defaultConfig {botToken}
runApp :: ReaderT AppConfig IO ()
runApp = do
    config <- ask
    userErr <-
        liftIO $
            runDiscord $
                def
                    { discordToken = botToken config
                    , discordOnEvent = eventHandler config
                    , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""
                    }
    liftIO $ TIO.putStrLn userErr
main :: IO ()
main = do
    config <- runMaybeT getAppConfig
    for_ config (runReaderT runApp)
eventHandler :: AppConfig -> Event -> DiscordHandler ()
eventHandler config event = case event of
    MessageCreate m -> unless (fromBot m) $ do
        channelRes <- restCall (Request.GetChannel (messageChannelId m))
        case channelRes of
            Left _ -> pure ()
            Right channel ->
                when (permissiveChannels (channels config) channel) $ do
                    void $
                        restCall
                            ( Request.CreateMessage
                                (messageChannelId m)
                                "Someone's Alive!!"
                            )
    _ -> pure ()
fromBot :: Message -> Bool
fromBot = userIsBot . messageAuthor
permissiveChannels :: [Text] -> Channel -> Bool
permissiveChannels names channel = case channel of
    ChannelText {..} -> channelName `elem` names
    _ -> False