{-# LANGUAGE OverloadedStrings #-}
module QuoteSystem ( receivers ) where
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Discord.Types ( Message ( messageChannel
, messageGuild
)
)
import Discord ( DiscordHandler )
import UnliftIO ( liftIO )
import CSV ( addToCSV
, readCSV
, writeHashMapToCSV
)
import Owoifier ( owoify )
import Utils ( sendMessageChan
, newCommand
, newDevCommand
)
receivers :: [Message -> DiscordHandler ()]
receivers :: [Message -> DiscordHandler ()]
receivers = [ Message -> DiscordHandler ()
receiveQuote, Message -> DiscordHandler ()
addQuote, Message -> DiscordHandler ()
rmQuote ]
quotePath :: FilePath
quotePath :: FilePath
quotePath = FilePath
"registeredQuotes.csv"
maxNameLen :: Int
maxNameLen :: Int
maxNameLen = Int
32
nameRE :: T.Text
nameRE :: Text
nameRE = Text
"(.{1," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
maxNameLen) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"})"
quoteTable :: IO (HM.HashMap T.Text T.Text)
quoteTable :: IO (HashMap Text Text)
quoteTable = do
[[Text]]
quote2DArray <- FilePath -> IO [[Text]]
readCSV FilePath
quotePath
let compatibleLines :: [[Text]]
compatibleLines = ([Text] -> Bool) -> [[Text]] -> [[Text]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Text]
line -> [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2) [[Text]]
quote2DArray
let listMap :: [(Text, Text)]
listMap = ([Text] -> (Text, Text)) -> [[Text]] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Text
key, Text
value] -> (Text
key, Text
value)) [[Text]]
compatibleLines
HashMap Text Text -> IO (HashMap Text Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap Text Text -> IO (HashMap Text Text))
-> HashMap Text Text -> IO (HashMap Text Text)
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Text, Text)]
listMap
storeQuote :: T.Text -> T.Text -> IO ()
storeQuote :: Text -> Text -> IO ()
storeQuote Text
name Text
content = FilePath -> [[Text]] -> IO ()
addToCSV FilePath
quotePath [[Text
name, Text
content]]
fetchQuote :: T.Text -> IO (Maybe T.Text)
fetchQuote :: Text -> IO (Maybe Text)
fetchQuote Text
name = Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
name (HashMap Text Text -> Maybe Text)
-> IO (HashMap Text Text) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (HashMap Text Text)
quoteTable
removeQuote :: T.Text -> IO ()
removeQuote :: Text -> IO ()
removeQuote Text
name = do
HashMap Text Text
newTable <- Text -> HashMap Text Text -> HashMap Text Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
name (HashMap Text Text -> HashMap Text Text)
-> IO (HashMap Text Text) -> IO (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (HashMap Text Text)
quoteTable
FilePath -> HashMap Text Text -> IO ()
writeHashMapToCSV FilePath
quotePath HashMap Text Text
newTable
receiveQuoteRE :: T.Text
receiveQuoteRE :: Text
receiveQuoteRE = Text
"(:|quote +)\"?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"?"
receiveQuote :: Message -> DiscordHandler ()
receiveQuote :: Message -> DiscordHandler ()
receiveQuote Message
msg = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newCommand Message
msg Text
receiveQuoteRE (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
quote -> do
let name :: Text
name = ([Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
tail) [Text]
quote
Maybe Text
textM <- IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text))
-> IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text)
fetchQuote Text
name
ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
msg) (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ case Maybe Text
textM of
Maybe Text
Nothing -> Text -> Text
owoify (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [
Text
"Nope, nothing there. ",
Text
"Maybe consider `:addquote \"[quote]\" \"[quote_message]\"`"
]
Just Text
text -> Text
text
addQuoteRE :: T.Text
addQuoteRE :: Text
addQuoteRE = Text
"addquote +\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" +\"(.{1,})\""
addQuote :: Message -> DiscordHandler ()
addQuote :: Message -> DiscordHandler ()
addQuote Message
msg = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newCommand Message
msg Text
addQuoteRE (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
quote ->
case Message -> Maybe ChannelId
messageGuild Message
msg of
Maybe ChannelId
Nothing ->
ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
msg) Text
"Only possible in a server!"
Just ChannelId
_ -> do
let [Text
name, Text
content] = [Text]
quote
Maybe Text
textM <- IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text))
-> IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text)
fetchQuote Text
name
case Maybe Text
textM of
Maybe Text
Nothing -> do
IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ()) -> IO () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
storeQuote Text
name Text
content
ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
msg)
(Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text
"New quote registered under `:quote " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`."
Just Text
_ -> ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
msg) (Text -> DiscordHandler ())
-> (Text -> Text) -> Text -> DiscordHandler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
owoify
(Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text
"Quote already exists my dude, try `:quote " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`."
rmQuoteRE :: T.Text
rmQuoteRE :: Text
rmQuoteRE = Text
"rmquote +\"?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"?"
rmQuote :: Message -> DiscordHandler ()
rmQuote :: Message -> DiscordHandler ()
rmQuote Message
msg = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newDevCommand Message
msg Text
rmQuoteRE (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
quote -> do
let name :: Text
name = [Text] -> Text
forall a. [a] -> a
head [Text]
quote
Maybe Text
textM <- IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text))
-> IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text)
fetchQuote Text
name
case Maybe Text
textM of
Maybe Text
Nothing -> ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
msg)
(Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Cannot remove that which doesn't exist."
Just Text
_ -> do
IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ()) -> IO () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
removeQuote Text
name
ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
msg) (Text -> DiscordHandler ())
-> (Text -> Text) -> Text -> DiscordHandler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
owoify
(Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text
"All done! Forgot all about `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`, was super bad anyways."