From c1662ba7b982a8502dc9f32031b7cb518df7f60e Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Sun, 16 May 2010 00:01:00 +0200 Subject: Rewrote nearly everything! * Rewrote the whole architecture to achieve extreme modularity * Added the ability to build a multiprotocol bot * Added cabal integration * Added configuration handling the XMonad style * Added configuration in ~/.hsbot * Refactored many many named and functions * Refactored data structures * Cleaned a big bunch of stuff --- Plugins/Quote.hs | 158 ------------------------------------------------------- 1 file changed, 158 deletions(-) delete mode 100644 Plugins/Quote.hs (limited to 'Plugins/Quote.hs') diff --git a/Plugins/Quote.hs b/Plugins/Quote.hs deleted file mode 100644 index 61e4558..0000000 --- a/Plugins/Quote.hs +++ /dev/null @@ -1,158 +0,0 @@ -module Plugins.Quote - ( mainQuote - ) where - -import Control.Concurrent.Chan -import Control.Exception -import Control.Monad.State -import qualified Data.Map as M -import Data.Maybe(fromMaybe) -import qualified Data.Text as T -import qualified Data.Text.IO as TIO -import Data.Time -import IO hiding (catch) -import Prelude hiding (catch) -import System.Random(randomRIO) - -import Hsbot.IRCPlugin -import Hsbot.Types -import Hsbot.Utils - --- | A quote element -data QuoteElt = QuoteElt - { eltQuoter :: String - , eltQuote :: String - } deriving (Read, Show) - --- | A quote object -data Quote = Quote - { quoter :: String - , quote :: [QuoteElt] - , quoteTime :: UTCTime - , votes :: Int - } deriving (Read, Show) - --- | A QuoteBot state -data QuoteBotState = QuoteBotState - { nextQuoteId :: Integer - , quoteBotDB :: M.Map Integer Quote - , quotesInProgress :: M.Map Integer Quote - } deriving (Read, Show) - --- | The QuoteBot monad -type QuoteBot a = StateT QuoteBotState (StateT PluginState IO) a - --- | The plugin's main entry point -mainQuote :: Chan BotMsg -> Chan BotMsg -> IO () -mainQuote serverChan chan = do - -- First of all we restore the database - txtQuoteBot <- TIO.readFile $ "quotedb.txt" - let quoteBot = read (T.unpack txtQuoteBot) :: QuoteBotState - -- The plugin main loop - let plugin = PluginState "Quote" serverChan chan - evalStateT (mapM_ sendRegisterCommand ["quote"]) plugin - _ <- (evalStateT (run quoteBot) plugin) `catch` (\(_ :: AsyncException) -> return quoteBot) - evalStateT (mapM_ sendUnregisterCommand ["quote"]) plugin - --- | The IrcPlugin monad main function -run :: QuoteBotState -> IrcPlugin (QuoteBotState) -run quoteBot = do - msg <- readMsg - quoteBot' <- eval msg - run quoteBot' - where - -- | evaluate what we just received - eval :: BotMsg -> IrcPlugin (QuoteBotState) - eval (InternalCmd intCmd) - | intCmdCmd intCmd == "RUN" = do - quoteBot' <- execStateT (runCommand intCmd) quoteBot - return quoteBot' - | otherwise = do - lift . trace $ show intCmd - return quoteBot - eval (InputMsg _) = return (quoteBot) - eval _ = return (quoteBot) - --- | run a command we received -runCommand :: IntCmd -> QuoteBot () -runCommand intCmd - | theCommand == "quote" = runQuoteCommand - | otherwise = do - lift . lift . trace $ show intCmd -- TODO : help message - where - -- | the message is a quote command - runQuoteCommand :: QuoteBot () - | length args == 0 = do - quoteDB <- gets quoteBotDB - x <- liftIO $ randomRIO (0, (length $ M.keys quoteDB) - 1) - mapM_ (lift . answerMsg request) (formatQuote (M.keys quoteDB !! x) (M.elems quoteDB !! x)) - | otherwise = do - dispatchQuoteCmd $ head args - -- | quote command dispatcher - dispatchQuoteCmd :: String -> QuoteBot () - dispatchQuoteCmd cmd - | cmd == "start" = do - quoteBot <- get - now <- liftIO $ getCurrentTime - let sender = takeWhile (/= '!') $ fromMaybe "ARGH" (prefix request) - newQuote = Quote sender [(quoteElt stuff)] now 0 - quoteId = nextQuoteId quoteBot - quotesInProgress' = M.insert quoteId newQuote (quotesInProgress quoteBot) - put $ quoteBot { nextQuoteId = quoteId + 1, quotesInProgress = quotesInProgress' } - lift $ answerMsg request ("New quoteId : " ++ show quoteId) - syncQuoteBot - | cmd == "append" = do - quoteBot <- get - case reads (head stuff) of - [(quoteId :: Integer,"")] -> do - case M.lookup quoteId (quotesInProgress quoteBot) of - Just theQuote -> do - let newQuote = theQuote { quote = (quoteElt $ tail stuff) : (quote theQuote) } - quotesInProgress' = M.insert quoteId newQuote (quotesInProgress quoteBot) - put $ quoteBot { quotesInProgress = quotesInProgress' } - syncQuoteBot - Nothing -> lift $ answerMsg request ("quoteId not found : " ++ (show quoteId)) - _ -> lift $ answerMsg request ("Invalid quoteId : " ++ (head stuff)) - | cmd == "commit" = do - quoteBot <- get - case reads (head stuff) of - [(quoteId :: Integer,"")] -> do - case M.lookup quoteId (quotesInProgress quoteBot) of - Just theQuote -> do - let quoteBotDB' = M.insert quoteId theQuote (quoteBotDB quoteBot) - quotesInProgress' = M.delete quoteId (quotesInProgress quoteBot) - put $ quoteBot { quoteBotDB = quoteBotDB', quotesInProgress = quotesInProgress' } - syncQuoteBot - Nothing -> lift $ answerMsg request ("quoteId not found : " ++ (show quoteId)) - _ -> lift $ answerMsg request ("Invalid quoteId : " ++ (head stuff)) - -- | cmd == "abort" = - | otherwise = lift $ answerMsg request ("Invalid command : " ++ cmd) - -- | Gets the new QuoteElt - quoteElt :: [String] -> QuoteElt - quoteElt msg = do - let budy = head $ msg - theQuote = unwords . tail $ msg - QuoteElt budy theQuote - -- | utilities - params = words . intCmdMsg $ intCmd - theCommand = head params - args = tail params - stuff = tail args - request = intCmdBotMsg intCmd - --- | The function that sync the quoteDB on disk -syncQuoteBot :: QuoteBot () -syncQuoteBot = do - quoteBot <- get - file' <- liftIO $ openFile "quotedb.txt" WriteMode - liftIO . hPutStr file' $ show quoteBot - liftIO $ hClose file' - -formatQuote :: Integer -> Quote -> [String] -formatQuote quoteId theQuote = - ("+---| " ++ (show quoteId) ++ " |-- Reported by " ++ (quoter theQuote) ++ " on " ++ (show $ quoteTime theQuote)) : - foldl (\acc x -> formatQuoteElt x : acc) ["`------------------------------------------"] (quote theQuote) - where - formatQuoteElt :: QuoteElt -> String - formatQuoteElt quoteElt = "| <" ++ (eltQuoter quoteElt) ++ "> " ++ (eltQuote quoteElt) - -- cgit v1.2.3