{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Manages all about reminders module Commands.Reminds where import Conf ( ) import qualified Control.Event as E import Control.Monad ( void ) import Control.Monad.IO.Unlift ( MonadUnliftIO(withRunInIO) ) import Data.Convertible ( ConvertResult , Convertible(safeConvert) ) import qualified Data.Text as T import Data.Time ( UTCTime ) import qualified Database.HDBC as DB import qualified Database.HDBC.Sqlite3 as DB.SQ3 import Discord ( DiscordHandler , restCall ) import Discord.Interactions ( ) import Discord.Requests ( ChannelRequest(CreateMessage) ) import Discord.Types ( Snowflake(..) ) data Remind = Remind { rmdUser :: Snowflake , rmdChannel :: Snowflake , rmdMessage :: T.Text , rmdDatetime :: UTCTime } instance Convertible Snowflake DB.SqlValue where safeConvert (Snowflake v) = safeConvert v setupRemindDb :: IO () setupRemindDb = do conn <- DB.SQ3.connectSqlite3 "db.sqlite3" DB.run conn "CREATE TABLE IF NOT EXISTS reminds\ \(id INTEGER PRIMARY KEY AUTOINCREMENT UNIQUE NOT NULL,\ \user INTEGER NOT NULL,\ \channel INTEGER NOT NULL,\ \message INTEGER NOT NULL,\ \dt DATETIME);" [] DB.commit conn DB.disconnect conn scheduleRemind :: E.EventSystem -> Remind -> DiscordHandler () scheduleRemind ev Remind {..} = do void $ withRunInIO $ \runInIo -> E.addEvent ev rmdDatetime $ void $ runInIo $ restCall $ CreateMessage rmdChannel $ "<@" `T.append` T.pack (show rmdUser) `T.append` "> **Reminder**\n" `T.append` rmdMessage registerRemind :: Remind -> IO () registerRemind Remind {..} = do conn <- DB.SQ3.connectSqlite3 "db.sqlite3" DB.run conn "INSERT INTO reminds(user, channel, message, dt)\ \VALUES (?,?,?,?)" [ DB.toSql rmdUser , DB.toSql rmdChannel , DB.toSql rmdMessage , DB.toSql rmdDatetime ] DB.commit conn DB.disconnect conn