diff options
Diffstat (limited to 'Hsbot')
-rw-r--r-- | Hsbot/Plugin/Quote.hs | 38 |
1 files changed, 38 insertions, 0 deletions
diff --git a/Hsbot/Plugin/Quote.hs b/Hsbot/Plugin/Quote.hs index adfcd24..daa5867 100644 --- a/Hsbot/Plugin/Quote.hs +++ b/Hsbot/Plugin/Quote.hs @@ -3,7 +3,11 @@ module Hsbot.Plugin.Quote () where +import Control.Monad.Reader +import Control.Monad.State +import Data.Acid import qualified Data.Map as M +import System.Random import Data.SafeCopy import Data.Typeable import System.Time @@ -45,3 +49,37 @@ $(deriveSafeCopy 0 'base ''QuoteElt) $(deriveSafeCopy 0 'base ''Quote) $(deriveSafeCopy 0 'base ''QuoteDB) +-- | Quote database transactions +getQuote :: Int -> Query QuoteDB (Maybe Quote) +getQuote quoteId = asks quoteBotDB >>= return . M.lookup quoteId + +getQuoteDB :: Query QuoteDB (M.Map Int Quote) +getQuoteDB = asks quoteBotDB + +isQuoteLockedFor :: Int -> String -> ClockTime -> Query QuoteDB (Either String Bool) +isQuoteLockedFor quoteId requestor now = do + theQuote <- asks quoteBotDB >>= return . M.lookup quoteId + case theQuote of + Just quote -> do + currentLock <- asks lockedQuotes >>= return . M.lookup quoteId + case currentLock of + 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? + Nothing -> return $ Right True + Nothing -> return $ Left "QuoteId not found" + +lockQuoteIdFor :: Int -> String -> ClockTime -> Update QuoteDB () +lockQuoteIdFor quoteId requestor now = get >>= \db -> put db { lockedQuotes = M.insert quoteId (requestor, now) (lockedQuotes db) } + +$(makeAcidic ''QuoteDB ['getQuote, 'getQuoteDB, 'isQuoteLockedFor, 'lockQuoteIdFor]) + +-- | gets a random quote from the database +getRandomQuote :: AcidState QuoteDB -> IO (Maybe Quote) +getRandomQuote quoteDB = do + db <- query' quoteDB GetQuoteDB + if M.size db > 0 + then getStdRandom (randomR (0, M.size db - 1)) >>= \rInt -> return . Just . snd $ M.elemAt rInt db + else return Nothing + |