You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

82 lines
2.9 KiB

3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
  1. {-# LANGUAGE MultiParamTypeClasses #-}
  2. {-# LANGUAGE OverloadedStrings #-}
  3. {-# LANGUAGE RecordWildCards #-}
  4. -- | Manages all about reminders
  5. module Commands.Reminds where
  6. import Conf ( )
  7. import qualified Control.Event as E
  8. import Control.Monad ( void )
  9. import Control.Monad.IO.Unlift ( MonadUnliftIO(withRunInIO) )
  10. import Data.Convertible ( ConvertResult
  11. , Convertible(safeConvert)
  12. )
  13. import qualified Data.Text as T
  14. import Data.Time ( UTCTime )
  15. import qualified Database.HDBC as DB
  16. import qualified Database.HDBC.Sqlite3 as DB.SQ3
  17. import Discord ( DiscordHandler
  18. , restCall
  19. )
  20. import Discord.Interactions ( )
  21. import Discord.Requests ( ChannelRequest(CreateMessage)
  22. )
  23. import Discord.Types ( Snowflake(..)
  24. , DiscordId(..)
  25. , ChannelId(..)
  26. , UserId(..)
  27. )
  28. data Remind = Remind
  29. { rmdUser :: UserId
  30. , rmdChannel :: ChannelId
  31. , rmdMessage :: T.Text
  32. , rmdDatetime :: UTCTime
  33. }
  34. instance Convertible Snowflake DB.SqlValue where
  35. safeConvert (Snowflake v) = safeConvert v
  36. setupRemindDb :: IO ()
  37. setupRemindDb = do
  38. conn <- DB.SQ3.connectSqlite3 "db.sqlite3"
  39. DB.run
  40. conn
  41. "CREATE TABLE IF NOT EXISTS reminds\
  42. \(id INTEGER PRIMARY KEY AUTOINCREMENT UNIQUE NOT NULL,\
  43. \user INTEGER NOT NULL,\
  44. \channel INTEGER NOT NULL,\
  45. \message INTEGER NOT NULL,\
  46. \dt DATETIME);"
  47. []
  48. DB.commit conn
  49. DB.disconnect conn
  50. scheduleRemind :: E.EventSystem -> Remind -> DiscordHandler ()
  51. scheduleRemind ev Remind {..} = do
  52. void $ withRunInIO $ \runInIo ->
  53. E.addEvent ev rmdDatetime
  54. $ void
  55. $ runInIo
  56. $ restCall
  57. $ CreateMessage rmdChannel
  58. $ "<@"
  59. <> T.pack (show rmdUser)
  60. <> "> **Reminder**\n"
  61. <> rmdMessage
  62. registerRemind :: Remind -> IO ()
  63. registerRemind Remind {..} = do
  64. conn <- DB.SQ3.connectSqlite3 "db.sqlite3"
  65. DB.run
  66. conn
  67. "INSERT INTO reminds(user, channel, message, dt)\
  68. \VALUES (?,?,?,?)"
  69. [ DB.toSql $ unId rmdUser
  70. , DB.toSql $ unId rmdChannel
  71. , DB.toSql rmdMessage
  72. , DB.toSql rmdDatetime
  73. ]
  74. DB.commit conn
  75. DB.disconnect conn