Draft: Framework basics

.env.example

@@ -7,4 +7,5 @@ EXEC_GROUP=123456789123456789
 MODERATOR_GROUP=321654987321654987
 SUPERUSER_GROUP=147258369147258369
 ALLOW_GIT_UPDATE=False
+VERBOSITY=0
 # NOTE: YOU MUST HAVE A NEWLINE AT THE END OF THE FILE

.gitignore

@@ -3,6 +3,5 @@
 .env
 db.*
 database*
-*.cabal
 stack.yaml.lock
 .gitattributes

README.md

@@ -23,6 +23,7 @@ Create a `.env` file containing the following keys. Consult `.env.example` if yo
 * `EXEC_GROUP` (optional) - the group ID assigned to exec members.
 * `MODERATOR_GROUP` (optional) - the group ID assigned to moderator members.
 * `SUPERUSER_GROUP` (optional) - the group ID assigned to the superuser. Strongly recommended
+* `VERBOSITY` (optional) - how loud the bot should be about things. 0 is loudest. currently only used in erroring command
 
 The three Group settings are optional, but without them any commands that require elevated permissions will not be able
 to be called when DEBUG is false. Users with the superuser group are able to run every command (including some dangerous

app/Main.hs

@@ -8,7 +8,7 @@ import Tablebot.Plugins (allPlugins)
 
 -- @main@ runs forever. This allows bot reloading by fully shutting down the bot and letting it restart.
 main :: IO ()
-main = runTablebotWithEnv allPlugins $ BotConfig {gamePlaying = "with dice", rootHelpText = rootBody}
+main = runTablebotWithEnv allPlugins $ BotConfig {gamePlaying = "with dice", rootHelpText = rootBody, botName = "Tablebot"}
 
 rootBody :: Text
 rootBody =

src/Tablebot.hs

@@ -48,6 +48,7 @@ import Tablebot.Plugins (addAdministrationPlugin)
 import Tablebot.Utility
 import Tablebot.Utility.Help
 import Text.Regex.PCRE ((=~))
+import UnliftIO (TVar, newTVarIO)
 
 -- | runTablebotWithEnv @plugins@ runs the bot using data found in the .env
 -- file with the @[CompiledPlugin]@ given. If you're looking to run the bot as
@@ -110,7 +111,7 @@ runTablebot vinfo dToken prefix dbpath plugins config =
     mapM_ (\migration -> runSqlPool (runMigration migration) pool) $ combinedMigrations plugin
     -- Create a var to kill any ongoing tasks.
     mvar <- newEmptyMVar :: IO (MVar [ThreadId])
-    cacheMVar <- newMVar (TCache M.empty vinfo) :: IO (MVar TablebotCache)
+    cacheMVar <- newTVarIO (TCache M.empty vinfo config) :: IO (TVar TablebotCache)
     userFacingError <-
       runDiscord $
         def

src/Tablebot/Handler.hs

@@ -16,7 +16,6 @@ module Tablebot.Handler
   )
 where
 
-import Control.Concurrent (MVar)
 import Control.Monad (unless)
 import Control.Monad.Exception
 import Control.Monad.IO.Class (MonadIO (liftIO))
@@ -40,6 +39,7 @@ import Tablebot.Internal.Types
 import Tablebot.Utility.Discord (sendEmbedMessage)
 import Tablebot.Utility.Exception
 import Tablebot.Utility.Types (TablebotCache)
+import UnliftIO (TVar)
 import UnliftIO.Concurrent
   ( ThreadId,
     forkIO,
@@ -85,12 +85,12 @@ eventHandler pl prefix = \case
 runCron ::
   Pool SqlBackend ->
   CompiledCronJob ->
-  ReaderT (MVar TablebotCache) DiscordHandler ThreadId
+  ReaderT (TVar TablebotCache) DiscordHandler ThreadId
 runCron pool (CCronJob delay fn) = do
   cache <- ask
   lift . forkIO $ withDelay cache
   where
-    withDelay :: MVar TablebotCache -> DiscordHandler ()
+    withDelay :: TVar TablebotCache -> DiscordHandler ()
     withDelay cache = do
       catchAny (runSqlPool (runReaderT fn cache) pool) (liftIO . print)
       liftIO $ threadDelay delay

src/Tablebot/Internal/Cache.hs

@@ -10,34 +10,33 @@
 -- Not intended for use by plugins directly, if you need to do that create a separate cache in your setup phase.
 module Tablebot.Internal.Cache where
 
-import Control.Concurrent.MVar (putMVar, readMVar, takeMVar)
-import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Reader (ask)
 import qualified Data.Map as M
 import Data.Text (Text)
 import Discord.Types
 import Tablebot.Utility.Types
+import UnliftIO (atomically, readTVarIO, writeTVar)
 
 lookupEmojiCache :: Text -> EnvDatabaseDiscord s (Maybe Emoji)
 lookupEmojiCache t = do
   mcache <- liftCache ask
-  cache <- liftIO $ readMVar mcache
+  cache <- readTVarIO mcache
   pure $ M.lookup t $ cacheKnownEmoji cache
 
 insertEmojiCache :: Text -> Emoji -> EnvDatabaseDiscord s ()
 insertEmojiCache t e = do
   mcache <- liftCache ask
-  cache <- liftIO $ takeMVar mcache
+  cache <- readTVarIO mcache
   let new = cache {cacheKnownEmoji = M.insert t e (cacheKnownEmoji cache)}
-  liftIO $ putMVar mcache new
+  atomically $ writeTVar mcache new
 
 addNewEmojiCache :: Text -> Emoji -> EnvDatabaseDiscord s ()
 addNewEmojiCache t e = do
   mcache <- liftCache ask
-  cache <- liftIO $ takeMVar mcache
+  cache <- readTVarIO mcache
   let emap = cacheKnownEmoji cache
       new = cache {cacheKnownEmoji = if M.member t emap then emap else M.insert t e emap}
-  liftIO $ putMVar mcache new
+  atomically $ writeTVar mcache new
 
 fillEmojiCache :: Guild -> EnvDatabaseDiscord s ()
 fillEmojiCache guild = do
@@ -47,5 +46,5 @@ fillEmojiCache guild = do
 getVersionInfo :: EnvDatabaseDiscord s VersionInfo
 getVersionInfo = do
   mcache <- liftCache ask
-  cache <- liftIO $ readMVar mcache
+  cache <- readTVarIO mcache
   pure $ cacheVersionInfo cache

src/Tablebot/Internal/Handler/Command.hs

@@ -17,7 +17,7 @@ module Tablebot.Internal.Handler.Command
 where
 
 import qualified Data.List.NonEmpty as NE
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Set (singleton, toList)
 import Data.Text (Text)
 import Data.Void (Void)
@@ -29,6 +29,8 @@ import Tablebot.Utility.Exception (BotException (ParserException), embedError)
 import Tablebot.Utility.Parser (skipSpace1, space, word)
 import Tablebot.Utility.Types (Parser)
 import Text.Megaparsec
+import Text.Read (readMaybe)
+import UnliftIO.Environment (lookupEnv)
 import qualified UnliftIO.Exception as UIOE (tryAny)
 
 -- | @parseNewMessage@ parses a new message, first by attempting to match the
@@ -58,17 +60,22 @@ parseNewMessage pl prefix m =
 -- If the parser errors, the last error (which is hopefully one created by
 -- '<?>') is sent to the user as a Discord message.
 parseCommands :: [CompiledCommand] -> Message -> Text -> CompiledDatabaseDiscord ()
-parseCommands cs m prefix = case parse (parser cs) "" (messageText m) of
-  Right p -> p m
-  Left e ->
-    let (errs, title) = makeBundleReadable e
-     in changeAction () . sendEmbedMessage m "" $ embedError $ ParserException title $ "```\n" ++ errorBundlePretty errs ++ "```"
+parseCommands cs m prefix = do
+  shouldError <- errorOnNoCommand
+  case parse (parser shouldError cs) "" (messageText m) of
+    Right p -> p m
+    Left e ->
+      let (errs, title) = makeBundleReadable e
+       in changeAction () . sendEmbedMessage m "" $ embedError $ ParserException title $ "```\n" ++ errorBundlePretty errs ++ "```"
   where
-    parser :: [CompiledCommand] -> Parser (Message -> CompiledDatabaseDiscord ())
-    parser cs' =
+    errorOnNoCommand :: CompiledDatabaseDiscord Bool = (== 0) . fromMaybe (0 :: Int) . (>>= readMaybe) <$> lookupEnv "VERBOSITY"
+    onError True = (<?> "No command with that name was found!")
+    onError False = (<|> pure (const (pure ())))
+    parser :: Bool -> [CompiledCommand] -> Parser (Message -> CompiledDatabaseDiscord ())
+    parser shouldError cs' =
       do
         _ <- chunk prefix
-        choice (map toErroringParser cs') <?> "No command with that name was found!"
+        onError shouldError $ choice (map toErroringParser cs')
     toErroringParser :: CompiledCommand -> Parser (Message -> CompiledDatabaseDiscord ())
     toErroringParser c = try (chunk $ commandName c) *> (skipSpace1 <|> eof) *> (try (choice $ map toErroringParser $ commandSubcommands c) <|> commandParser c)
 

src/Tablebot/Internal/Types.hs

@@ -11,16 +11,15 @@
 -- allow homogeneous storage throughout the rest of the implementation.
 module Tablebot.Internal.Types where
 
-import Control.Concurrent.MVar (MVar)
 import Control.Monad.Reader (ReaderT)
-import Data.Default
 import Data.Text (Text)
 import Database.Persist.Sqlite (Migration, SqlPersistT)
 import Discord
 import Discord.Types
 import Tablebot.Utility.Types
+import UnliftIO (TVar)
 
-type CompiledDatabaseDiscord = ReaderT (MVar TablebotCache) (SqlPersistT DiscordHandler)
+type CompiledDatabaseDiscord = ReaderT (TVar TablebotCache) (SqlPersistT DiscordHandler)
 
 -- | @CompiledPlugin@ represents the internal format of the plugins.
 -- Its main job is to convert all the plugins into one type by collapsing
@@ -82,19 +81,3 @@ data CompiledCronJob = CCronJob
   { timeframe :: Int,
     onCron :: CompiledDatabaseDiscord ()
   }
-
--- * Configuration type
-
--- Allows others to configure the bot.
-
-data BotConfig = BotConfig
-  { rootHelpText :: Text,
-    gamePlaying :: Text
-  }
-
-instance Default BotConfig where
-  def =
-    BotConfig
-      { rootHelpText = "This bot is built off the Tablebot framework (<https://github.com/WarwickTabletop/tablebot>).",
-        gamePlaying = "Kirby: Planet Robobot"
-      }

src/Tablebot/Utility/Embed.hs

@@ -21,6 +21,9 @@ import Tablebot.Utility.Types (DiscordColour)
 simpleEmbed :: Text -> Embed
 simpleEmbed t = createEmbed $ CreateEmbed "" "" Nothing "" "" Nothing t [] Nothing "" Nothing Nothing
 
+basicEmbed :: Text -> Text -> Embed
+basicEmbed title body = createEmbed $ CreateEmbed "" "" Nothing title "" Nothing body [] Nothing "" Nothing Nothing
+
 addTitle :: Embeddable e => Text -> e -> Embed
 addTitle t e =
   (asEmbed e)