botiut/app/Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import           Commands                       ( edtCommand
                                                , edtResponse
                                                , groupCommand
                                                , groupResponse
                                                , helpCommand
                                                , helpResponse
                                                , pingCommand
                                                , pingResponse
                                                , remindCommand
                                                , remindResponse
                                                )
import           Commands.EDT                   ( getEdt )
import           Commands.Reminds               ( Remind(..)
                                                , scheduleRemind
                                                , setupRemindDb
                                                )
import           Conf                           ( Config(..)
                                                , Group(..)
                                                , readConfig
                                                )
import qualified Control.Concurrent
import qualified Control.Event                 as E
import           Control.Monad                  ( void
                                                , when
                                                )
import           Control.Monad.IO.Unlift        ( liftIO
                                                , toIO
                                                , withRunInIO
                                                )
import qualified Data.Map.Strict               as Map
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as TIO
import           Data.Time                      ( getCurrentTime )
import qualified Database.HDBC                 as DB
import qualified Database.HDBC.Sqlite3         as DB.SQ3
import           Discord                        ( DiscordHandler
                                                , RunDiscordOpts(..)
                                                , def
                                                , restCall
                                                , runDiscord
                                                , sendCommand
                                                )
import           Discord.Interactions           ( Interaction(..)
                                                , InteractionDataApplicationCommand(..)
                                                , interactionResponseBasic
                                                )
import qualified Discord.Requests              as R
import           Discord.Types                  ( Activity(..)
                                                , ActivityType(..)
                                                , Event(..)
                                                , GatewaySendable(..)
                                                , PartialApplication(..)
                                                , Snowflake(Snowflake)
                                                , UpdateStatusOpts(..)
                                                , UpdateStatusType(..)
                                                )
import qualified System.Cron.Schedule          as Cron
import           UnliftIO.Directory             ( doesFileExist
                                                , removeFile
                                                )

main :: IO ()
main = do
  tok         <- TIO.readFile "./auth.secret"
  conf        <- readConfig "./conf.yaml"
  eventSystem <- E.initEventSystem

  err         <- runDiscord $ def
    { discordToken   = tok
    , discordOnStart = onDiscordStart conf eventSystem
    , discordOnEnd   = liftIO $ putStrLn "Ended"
    , discordOnEvent = onDiscordEvent conf eventSystem
    , discordOnLog   = \s -> TIO.putStrLn s >> TIO.putStrLn ""
    }
  TIO.putStrLn err

onDiscordStart :: Config -> E.EventSystem -> DiscordHandler ()
onDiscordStart conf@Config {..} eventSystem = do
  let activity :: Activity
      activity = def { activityName = "Doing stuff"
                     , activityType = ActivityTypeGame
                     , activityUrl  = Nothing
                     }
      opts :: UpdateStatusOpts
      opts = UpdateStatusOpts { updateStatusOptsSince     = Nothing
                              , updateStatusOptsGame      = Just activity
                              , updateStatusOptsNewStatus = UpdateStatusOnline
                              , updateStatusOptsAFK       = False
                              }
  sendCommand (UpdateStatus opts)

  let glist = Map.toList configGroups

  withRunInIO $ \runInIO -> Cron.execSchedule $ do
    Cron.addJob (runInIO $ pushgroupedt conf "tomorrow" glist)
                configAutoEDTCronDay
    Cron.addJob (runInIO $ pushgroupedt conf "week" glist) configAutoEDTCronWeek

  -- Ensure the database is setup

  liftIO setupRemindDb

  -- Get the reminders out of the database
  conn  <- liftIO $ DB.SQ3.connectSqlite3 "db.sqlite3"

  query <- liftIO $ DB.prepare
    conn
    "SELECT user, channel, message, dt \
             \FROM reminds \
             \WHERE (datetime(dt) > datetime('now'));"
  liftIO $ DB.execute query []

  reminds <- liftIO $ DB.fetchAllRows' query
  mapM_
    (\[u, c, m, d] -> do
      liftIO $ print [u, c, m, d]
      scheduleRemind
        eventSystem
        Remind { rmdUser     = Snowflake $ DB.fromSql u
               , rmdChannel  = Snowflake $ DB.fromSql c
               , rmdMessage  = DB.fromSql m
               , rmdDatetime = DB.fromSql d
               }
    )
    reminds
  liftIO $ putStrLn "Started"

onDiscordEvent :: Config -> E.EventSystem -> Event -> DiscordHandler ()
onDiscordEvent conf@Config {..} eventSystem (Ready _ _ _ _ _ _ (PartialApplication i _))
  = do
    mapM_
      (maybe
        (return ())
        (void . restCall . R.CreateGuildApplicationCommand i configServer)
      )
      [ pingCommand
      , edtCommand conf
      , remindCommand
      , groupCommand conf
      , helpCommand
      ]

onDiscordEvent conf@Config {..} eventSystem (InteractionCreate InteractionApplicationCommand { interactionDataApplicationCommand = InteractionDataApplicationCommandChatInput { interactionDataApplicationCommandName = name, interactionDataApplicationCommandOptions = opts, ..}, interactionChannelId = Just channel, interactionGuildId = Just guild, interactionUser = user, ..})
  = do
    response <- responseIO
    void $ restCall
      (R.CreateInteractionResponse interactionId interactionToken response)
 where
  responseIO = case name of
    "ping"   -> liftIO $ pingResponse conf
    "edt"    -> liftIO $ edtResponse conf opts
    "remind" -> remindResponse opts eventSystem channel user
    "group"  -> groupResponse conf user guild opts
    "help"   -> liftIO helpResponse
    _ ->
      return $ interactionResponseBasic $ "Unhandled Command: " `T.append` name
onDiscordEvent _ _ _ = return ()

pushgroupedt :: Config -> T.Text -> [(T.Text, Group)] -> DiscordHandler ()
pushgroupedt conf@Config {..} day glist = do
  mapM_
    (\(gn, Group { groupChannel = gc }) -> do
      edt <- liftIO $ getEdt conf $ Map.fromList [("group", gn), ("day", day)]
      liftIO
        $          TIO.putStrLn
        $          "Putting out time table for group "
        `T.append` gn
        `T.append` " in "
        `T.append` T.pack (show gc)
        `T.append` ":\n"
        `T.append` edt
      restCall $ R.CreateMessage gc (edt `T.append` "\nAutomatic time table")
      return ()
    )
    glist