diff options
author | Julien Dessaux | 2011-09-19 00:36:40 +0200 |
---|---|---|
committer | Julien Dessaux | 2011-09-19 00:36:40 +0200 |
commit | 5e260c4fa97e22d7585f9aa98cbb922536fafd67 (patch) | |
tree | 27e484b94781c2089d96a3ea6a3213fde7d9e493 /Hsbot/Plugin | |
parent | Made quote append slightly more readable. (diff) | |
download | hsbot-5e260c4fa97e22d7585f9aa98cbb922536fafd67.tar.gz hsbot-5e260c4fa97e22d7585f9aa98cbb922536fafd67.tar.bz2 hsbot-5e260c4fa97e22d7585f9aa98cbb922536fafd67.zip |
Added quote delete.
Diffstat (limited to 'Hsbot/Plugin')
-rw-r--r-- | Hsbot/Plugin/Quote.hs | 54 |
1 files changed, 53 insertions, 1 deletions
diff --git a/Hsbot/Plugin/Quote.hs b/Hsbot/Plugin/Quote.hs index b74244c..baacb77 100644 --- a/Hsbot/Plugin/Quote.hs +++ b/Hsbot/Plugin/Quote.hs @@ -90,13 +90,18 @@ lockQuoteIdFor :: QuoteID -> IRC.UserName -> IRC.Channel -> UTCTime -> Update Qu lockQuoteIdFor quoteId requestor channel now = get >>= \db -> put db { lockedQuotes = M.insert quoteId (requestor, now) (lockedQuotes db) , lastActive = M.insert channel quoteId (lastActive db) } +deleteQuote :: QuoteID -> IRC.Channel -> Update QuoteDB () +deleteQuote quoteId channel = get >>= \db -> put db { quoteBotDB = M.delete quoteId (quoteBotDB db) + , lockedQuotes = M.delete quoteId (lockedQuotes db) + , lastActive = M.delete channel (lastActive db) } + setQuote :: QuoteID -> Quote -> Update QuoteDB () setQuote quoteId theQuote = get >>= \db -> put db { quoteBotDB = M.insert quoteId theQuote (quoteBotDB db) } getLastActiveQuote :: IRC.Channel -> Query QuoteDB (Maybe QuoteID) getLastActiveQuote channel = asks lastActive >>= return . M.lookup channel -$(makeAcidic ''QuoteDB [ 'getQuote, 'getQuoteDB, 'isQuoteLockedFor, 'lockQuoteIdFor, 'setQuote +$(makeAcidic ''QuoteDB [ 'getQuote, 'getQuoteDB, 'isQuoteLockedFor, 'lockQuoteIdFor, 'deleteQuote, 'setQuote , 'getLastActiveQuote ]) -- | gets a random quote from the database @@ -133,6 +138,15 @@ theQuote = do case lastQid of Just qid -> quoteAppend quoteDB msg qid quotee . unwords $ quoteID : quoteTxt Nothing -> answerMsg msg $ getSender msg ++ " : Invalid quoteID." + "quote":"delete":quoteID:eltID -> + case reads quoteID :: [(Int, String)] of + (qid,_):_ -> case eltID of + [] -> quoteDelete quoteDB msg qid + eltID':[] -> case reads eltID' :: [(Int, String)] of + (eltid,_):_ -> quoteDeleteElt quoteDB msg qid eltid + _ -> answerMsg msg $ getSender msg ++ ": Invalid elementID." + _ -> answerMsg msg $ getSender msg ++ ": Invalid elementID." + _ -> answerMsg msg $ getSender msg ++ " : Invalid quoteID." "quote":"help":"append":_ -> answerMsg msg $ "quote append [QUOTEID] QUOTEE QUOTE" ++ "If no QUOTEID is provided, tries to append to the last active quote." "quote":"help":"delete":_ -> do @@ -183,3 +197,41 @@ quoteAppend quoteDB msg quoteID quotee text = do sender = getSender msg channel = getChannel msg +quoteDelete :: AcidState QuoteDB -> IRC.Message -> QuoteID -> Plugin (Env IO) () +quoteDelete quoteDB msg quoteID = do + now <- liftIO getCurrentTime + activeLock <- query' quoteDB (IsQuoteLockedFor quoteID sender now) + case activeLock of + Just True -> do + _ <- update' quoteDB (DeleteQuote quoteID channel) + answerMsg msg $ sender ++ ": quote " ++ show quoteID ++ "." + Just False -> answerMsg msg $ sender ++ ": Someone else is editing this quote right now." + Nothing -> answerMsg msg $ sender ++ ":quoteId not found." + where + sender = getSender msg + channel = getChannel msg + +quoteDeleteElt :: AcidState QuoteDB -> IRC.Message -> QuoteID -> Int -> Plugin (Env IO) () +quoteDeleteElt quoteDB msg quoteID eltID = do + now <- liftIO getCurrentTime + activeLock <- query' quoteDB (IsQuoteLockedFor quoteID sender now) + case activeLock of + Just True -> do + _ <- update' quoteDB (LockQuoteIdFor quoteID sender channel now) + mQuote <- query' quoteDB (GetQuote quoteID) + let newQuote = fromMaybe emptyQuote mQuote + newQuote' = newQuote { quotE = getRidOfEltFrom (quotE newQuote) } + _ <- update' quoteDB (SetQuote quoteID newQuote') + answerMsg msg $ sender ++ ": Appended to quote " ++ show quoteID ++ "." + Just False -> answerMsg msg $ sender ++ ": Someone else is editing this quote right now." + Nothing -> answerMsg msg $ sender ++ ":quoteId not found." + where + sender = getSender msg + channel = getChannel msg + getRidOfEltFrom :: [QuoteElt] -> [QuoteElt] + getRidOfEltFrom elts + | eltID <= 0 = elts + | eltID >= length elts = elts + | otherwise = let (l, r) = splitAt eltID elts + in l ++ tail r + |