discord-haskell-1.5.1: examples/ping-pong.hs

{-# LANGUAGE OverloadedStrings #-}  -- allows "strings" to be Data.Text

import Control.Monad (when, forM_)
import Control.Concurrent (threadDelay)
import Data.Char (toLower)
import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.Text.IO as TIO

import Discord
import Discord.Types
import qualified Discord.Requests as R

-- Allows this code to be an executable. See discord-haskell.cabal
main :: IO ()
main = pingpongExample

-- | Replies "pong" to every message that starts with "ping"
pingpongExample :: IO ()
pingpongExample = do
  tok <- TIO.readFile "./examples/auth-token.secret"

  -- open ghci and run  [[ :info RunDiscordOpts ]] to see available fields
  t <- runDiscord $ def { discordToken = tok
                        , discordOnStart = startHandler
                        , discordOnEnd = putStrLn "Ended"
                        -- , discordOnEvent = eventHandler
                        , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""
                        }
  threadDelay (1 `div` 10 * 10^6)
  TIO.putStrLn t

-- If the start handler throws an exception, discord-haskell will gracefully shutdown
--     Use place to execute commands you know you want to complete
startHandler :: DiscordHandle -> IO ()
startHandler dis = do
  Right partialGuilds <- restCall dis R.GetCurrentUserGuilds
  bs <- B.readFile "./examples/embed-photo.jpg"
  bs2 <- B.readFile "./examples/blart.jpg"

  forM_ partialGuilds $ \pg -> do
    Right guild <- restCall dis $ R.GetGuild (partialGuildId pg)
    Right chans <- restCall dis $ R.GetGuildChannels (guildId guild)
    case filter isTextChannel chans of
      (c:_) -> do Right m <- restCall dis $ R.CreateMessageEmbed (channelId c) "Hello! I will reply to pings with pongs" $def { createEmbedTitle = "BEFORE"
                                          , createEmbedImage = Just $ CreateEmbedImageUpload bs}
                  print m
                  print ()
                  threadDelay $ 5 * 10^6
                  e <- restCall dis $ R.EditMessage (messageChannel m, messageId m) "New " $
                               Just $ def { createEmbedTitle = "asdf"
                                          , createEmbedThumbnail = Just $ CreateEmbedImageUpload bs
                                          , createEmbedFooterIcon = Just $ CreateEmbedImageUpload bs2
                                          }
                  print e
                  pure ()
      _ -> pure ()

isTextChannel :: Channel -> Bool
isTextChannel (ChannelText {}) = True
isTextChannel _ = False