adyxax/hsbot
Archived
1
0
Fork 0
Code Issues Activity

Fixed compilation errors. Since I forgot to add the quote module to cabal there were many!

Browse source
This commit is contained in:
Julien Dessaux 2011-06-23 01:11:30 +02:00
parent 4a2164d938
commit 6f126049a3
2 changed files with 40 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

75
Hsbot/Plugin/Quote.hs
View file

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

2
hsbot.cabal
View file

@ -25,6 +25,7 @@ Library
Hsbot.Plugin Hsbot.Plugin
Hsbot.Plugin.Duck Hsbot.Plugin.Duck
Hsbot.Plugin.Ping Hsbot.Plugin.Ping
Hsbot.Plugin.Quote
Hsbot.Types Hsbot.Types
Hsbot.Utils Hsbot.Utils
Extensions: DeriveDataTypeable FlexibleContexts ScopedTypeVariables Extensions: DeriveDataTypeable FlexibleContexts ScopedTypeVariables
@ -44,6 +45,7 @@ Library
safecopy, safecopy,
tls >= 0.6.1, tls >= 0.6.1,
tls-extra >= 0.2.0, tls-extra >= 0.2.0,
time,
xdg-basedir xdg-basedir