1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
{-# 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
|
