diff options
Diffstat (limited to '')
| -rw-r--r-- | Hsbot/Plugin/Quote.hs | 75 |
1 files changed, 38 insertions, 37 deletions
diff --git a/Hsbot/Plugin/Quote.hs b/Hsbot/Plugin/Quote.hs index c6cfb40..92a4b13 100644 --- a/Hsbot/Plugin/Quote.hs +++ b/Hsbot/Plugin/Quote.hs @@ -8,16 +8,17 @@ module Hsbot.Plugin.Quote import Control.Monad.Reader import Control.Monad.State import Data.Acid -import qualified Data.Map as M -import qualified Network.IRC as IRC -import System.Random import Data.SafeCopy +import Data.Time +import Data.Time.Clock.POSIX import Data.Typeable -import System.Time +import System.Random +import qualified Data.Map as M +import qualified Network.IRC as IRC +import System.Environment.XDG.BaseDir import Hsbot.Message import Hsbot.Types -import Hsbot.Utils -- | A quote element data QuoteElt = QuoteElt @@ -25,21 +26,21 @@ data QuoteElt = QuoteElt , eltQuote :: String } deriving (Show, Typeable) -type QuoteId = Int +type QuoteID = Int -- | A quote object data Quote = Quote { quoter :: IRC.UserName - , quote :: [QuoteElt] - , quoteTime :: ClockTime + , quotE :: [QuoteElt] + , quoteTime :: UTCTime , votes :: Int , voters :: M.Map IRC.UserName QuoteID } deriving (Show, Typeable) emptyQuote :: Quote emptyQuote = Quote { quoter = "" - , quote = [] - , quoteTime = TOD 0 0 + , quotE = [] + , quoteTime = posixSecondsToUTCTime 0 , votes = 0 , voters = M.empty } @@ -47,15 +48,15 @@ emptyQuote = Quote { quoter = "" data QuoteDB = QuoteDB { nextQuoteId :: QuoteID , quoteBotDB :: M.Map QuoteID Quote - , lockedQuotes :: M.Map QuoteID (IRC.UserName, ClockTime) - , lastActive :: M.Map IRC.Channel QuoteID + , lockedQuotes :: M.Map QuoteID (IRC.UserName, UTCTime) + , lastActive :: M.Map IRC.Channel (QuoteID, UTCTime) } deriving (Show, Typeable) emptyQuoteDB :: QuoteDB emptyQuoteDB = QuoteDB { nextQuoteId = 0 , quoteBotDB = M.empty , lockedQuotes = M.empty - , lastActive = Nothing } + , lastActive = M.empty } $(deriveSafeCopy 0 'base ''QuoteElt) $(deriveSafeCopy 0 'base ''Quote) @@ -70,7 +71,7 @@ getQuoteDB = asks quoteBotDB -- TODO : a function for cleaning locks -isQuoteLockedFor :: QuoteID -> IRC.UserName -> ClockTime -> Query QuoteDB (Either String Bool) +isQuoteLockedFor :: QuoteID -> IRC.UserName -> UTCTime -> Query QuoteDB (Either String Bool) isQuoteLockedFor quoteId requestor now = do theQuote <- asks quoteBotDB >>= return . M.lookup quoteId case theQuote of @@ -80,11 +81,11 @@ isQuoteLockedFor quoteId requestor now = do Just (owner, lockStamp) -> if owner == requestor then return $ Right True - else return . Right $ (addToClockTime (TimeDiff 0 0 0 0 5 0 0) lockStamp > now) -- Is the entry older than 5 min? + else return . Right $ (addUTCTime 300 lockStamp > now) -- Is the entry older than 5 min? Nothing -> return $ Right True Nothing -> return $ Left "QuoteId not found" -lockQuoteIdFor :: QuoteID -> IRC.UserName -> ClockTime -> Update QuoteDB () +lockQuoteIdFor :: QuoteID -> IRC.UserName -> UTCTime -> Update QuoteDB () lockQuoteIdFor quoteId requestor now = get >>= \db -> put db { lockedQuotes = M.insert quoteId (requestor, now) (lockedQuotes db) } $(makeAcidic ''QuoteDB ['getQuote, 'getQuoteDB, 'isQuoteLockedFor, 'lockQuoteIdFor]) @@ -107,7 +108,7 @@ quote = PluginId theQuote :: Plugin (Env IO) () -- TODO : an argument for the history size theQuote = do baseDir <- liftIO $ System.Environment.XDG.BaseDir.getUserDataDir "hsbot" - statDB <- liftIO $ openAcidStateFrom (baseDir ++ "/quoteDB/") emptyQuoteDB + quoteDB <- liftIO $ openAcidStateFrom (baseDir ++ "/quoteDB/") emptyQuoteDB forever $ readMsg >>= eval quoteDB where eval :: AcidState QuoteDB -> Message -> Plugin (Env IO) () @@ -115,34 +116,34 @@ theQuote = do | IRC.msg_command msg == "PRIVMSG" = do cmdArgs <- lift $ getCommand msg case cmdArgs of - "quote":"help":"append":_ -> answerMsg "quote append QUOTEID QUOTEE QUOTE" + "quote":"help":"append":_ -> answerMsg msg "quote append QUOTEID QUOTEE QUOTE" "quote":"help":"delete":_ -> do - answerMsg "quote delete QUOTEID [ELTID] :" - answerMsg $ concat [ " If an ELTID is provided, deletes the ELTID's line (starting from zero) " - , "in the quote QUOTEID. If not the whole quote is deleted." ] + answerMsg msg "quote delete QUOTEID [ELTID] :" + answerMsg msg $ concat [ " If an ELTID is provided, deletes the ELTID's line (starting from zero) " + , "in the quote QUOTEID. If not the whole quote is deleted." ] "quote":"help":"quick":_ -> do - answerMsg "quote [quick] QUOTEE [QUOTE] :" - answerMsg $ concat [ " Begins a quote for QUOTEE. You must provide the keywork quick if the " - , "QUOTEE's nickname is a reserved word for this quote module. If no QUOTE is " - , "provided this module lookup it's conversation history and records the " - , "last sentence of QUOTEE." ] - "quote":"help":"show":_ -> answerMsg "quote show { QUOTEID | random [MIN_SCORE] }" + answerMsg msg "quote [quick] QUOTEE [QUOTE] :" + answerMsg msg $ concat [ " Begins a quote for QUOTEE. You must provide the keywork quick if the " + , "QUOTEE's nickname is a reserved word for this quote module. If no QUOTE is " + , "provided this module lookup it's conversation history and records the " + , "last sentence of QUOTEE." ] + "quote":"help":"show":_ -> answerMsg msg "quote show { QUOTEID | random [MIN_SCORE] }" "quote":"help":"stat":_ -> do - answerMsg "quote stat" - answerMsg " Compute statistics about the quote database : Most quoters, most quoted " + answerMsg msg "quote stat" + answerMsg msg " Compute statistics about the quote database : Most quoters, most quoted " "quote":"help":[] -> do - answerMsg $ concat [ "Usage: quote { [quick] QUOTEE [QUOTE] | append QUOTEID QUOTEE QUOTE | " + answerMsg msg $ concat [ "Usage: quote { [quick] QUOTEE [QUOTE] | append QUOTEID QUOTEE QUOTE | " , "delete QUOTEID [ELTID] | show { QUOTEID | random [MIN_SCORE] } | stat }" ] - "quote":"help":_ -> answerMsg "Invalid help topic." + "quote":"help":_ -> answerMsg msg "Invalid help topic." "quote":_ -> answerMsg msg "Invalid quote command." "vote":"help":"quick":_ -> do - answerMsg "vote [quick] [QUOTEID] { +1 | -1 | ++ | -- }" - answerMsg $ concat [ " Vote for a quote. You can also vote for the last active quote on this chan " - , "by typing something that begins by +1, -1 or ++ or --." ] - "vote":"help":[] -> answerMsg $ concat [ "Usage: vote { [quick] [QUOTEID] { +1 | -1 } | show [QUOTEID] | stat }" - "vote":"help":_ -> answerMsg "Invalid help topic." + answerMsg msg "vote [quick] [QUOTEID] { +1 | -1 | ++ | -- }" + answerMsg msg $ concat [ " Vote for a quote. You can also vote for the last active quote on this chan " + , "by typing something that begins by +1, -1 or ++ or --." ] + "vote":"help":[] -> answerMsg msg "Usage: vote { [quick] [QUOTEID] { +1 | -1 } | show [QUOTEID] | stat }" + "vote":"help":_ -> answerMsg msg "Invalid help topic." "vote":_ -> answerMsg msg "Invalid vote command." _ -> return () | otherwise = return () - eval _ _ _ _ = return () + eval _ _ = return () |