{-# 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` maps quotes to their 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` is the regex for the quote addition command. Quote texts and names *must* be wrapped in
-- double quotes when adding.
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."