summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Plugins/Quote.hs143
-rw-r--r--README2
-rw-r--r--TODO3
3 files changed, 127 insertions, 21 deletions
diff --git a/Plugins/Quote.hs b/Plugins/Quote.hs
index db473f9..61e4558 100644
--- a/Plugins/Quote.hs
+++ b/Plugins/Quote.hs
@@ -5,49 +5,154 @@ module Plugins.Quote
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.Time (ClockTime)
+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 :: [String]
- , quoteTime :: ClockTime
+ , quote :: [QuoteElt]
+ , quoteTime :: UTCTime
, votes :: Int
- } deriving (Show)
+ } deriving (Read, Show)
-- | A QuoteBot state
-type QuoteDB = [Quote]
+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 QuoteDB IO a
+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 :: IrcPlugin ()
-run = forever $ do
+run :: QuoteBotState -> IrcPlugin (QuoteBotState)
+run quoteBot = do
msg <- readMsg
- eval msg
+ 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
- eval :: BotMsg -> IrcPlugin ()
- eval (InternalCmd intCmd) = do
- case intCmdCmd intCmd of
- "RUN" -> let stuff = words $ intCmdMsg intCmd
- in case head stuff of
- "quote" -> lift $ trace $ "Quote module has been invoked for: " ++ (show intCmd)
- _ -> lift $ trace $ show intCmd -- TODO : help message
- _ -> lift $ trace $ show intCmd
- eval (InputMsg msg) = return ()
- eval _ = return ()
+ formatQuoteElt :: QuoteElt -> String
+ formatQuoteElt quoteElt = "| <" ++ (eltQuoter quoteElt) ++ "> " ++ (eltQuote quoteElt)
diff --git a/README b/README
index 33619ee..feb7cf0 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
Dependances :
-------------
hs-plugin
-haskell-irc
+text
diff --git a/TODO b/TODO
index b7bb080..7da8f6c 100644
--- a/TODO
+++ b/TODO
@@ -1,6 +1,5 @@
:julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
-* Write the quote module
* write the vote system for the quote module
* only the quote reporter should be able to edit it
* detect too identical quoting in a raw, or implement quote abort
@@ -23,4 +22,6 @@
* Make the bot auto-reconnect (/!\ admin plugin!)
* discard all trace with a color param and replace those with functions info/warn/error/debug
* write a safe reload : try reload before unloading
+* remove from Types.hs what can be removed from it
+