85 lines
2.7 KiB
Haskell
85 lines
2.7 KiB
Haskell
{-# LANGUAGE TypeFamilies, DeriveDataTypeable, TemplateHaskell #-}
|
|
-- | This module is an IRC plugin that manages quotes for posterity and legend
|
|
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
|
|
|
|
import Hsbot.Message
|
|
import Hsbot.Types
|
|
import Hsbot.Utils
|
|
|
|
-- | A quote element
|
|
data QuoteElt = QuoteElt
|
|
{ eltQuotee :: String
|
|
, eltQuote :: String
|
|
} deriving (Show, Typeable)
|
|
|
|
-- | A quote object
|
|
data Quote = Quote
|
|
{ quoter :: String
|
|
, quote :: [QuoteElt]
|
|
, quoteTime :: ClockTime
|
|
, votes :: Int
|
|
, voters :: M.Map String Int
|
|
} deriving (Show, Typeable)
|
|
|
|
emptyQuote :: Quote
|
|
emptyQuote = Quote { quoter = ""
|
|
, quote = []
|
|
, quoteTime = TOD 0 0
|
|
, votes = 0
|
|
, voters = M.empty }
|
|
|
|
-- The Quote database
|
|
data QuoteDB = QuoteDB
|
|
{ nextQuoteId :: Int
|
|
, quoteBotDB :: M.Map Int Quote
|
|
, lockedQuotes :: M.Map Int (String, ClockTime)
|
|
} deriving (Show, Typeable)
|
|
|
|
$(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
|
|
|