Fixed compilation errors. Since I forgot to add the quote module to cabal there were many!
This commit is contained in:
parent
4a2164d938
commit
6f126049a3
2 changed files with 40 additions and 37 deletions
|
@ -8,16 +8,17 @@ module Hsbot.Plugin.Quote
|
|||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
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 Network.IRC as IRC
|
||||
import System.Random
|
||||
import Data.SafeCopy
|
||||
import Data.Typeable
|
||||
import System.Time
|
||||
import System.Environment.XDG.BaseDir
|
||||
|
||||
import Hsbot.Message
|
||||
import Hsbot.Types
|
||||
import Hsbot.Utils
|
||||
|
||||
-- | A quote element
|
||||
data QuoteElt = QuoteElt
|
||||
|
@ -25,21 +26,21 @@ data QuoteElt = QuoteElt
|
|||
, eltQuote :: String
|
||||
} deriving (Show, Typeable)
|
||||
|
||||
type QuoteId = Int
|
||||
type QuoteID = Int
|
||||
|
||||
-- | A quote object
|
||||
data Quote = Quote
|
||||
{ quoter :: IRC.UserName
|
||||
, quote :: [QuoteElt]
|
||||
, quoteTime :: ClockTime
|
||||
, quotE :: [QuoteElt]
|
||||
, quoteTime :: UTCTime
|
||||
, votes :: Int
|
||||
, voters :: M.Map IRC.UserName QuoteID
|
||||
} deriving (Show, Typeable)
|
||||
|
||||
emptyQuote :: Quote
|
||||
emptyQuote = Quote { quoter = ""
|
||||
, quote = []
|
||||
, quoteTime = TOD 0 0
|
||||
, quotE = []
|
||||
, quoteTime = posixSecondsToUTCTime 0
|
||||
, votes = 0
|
||||
, voters = M.empty }
|
||||
|
||||
|
@ -47,15 +48,15 @@ emptyQuote = Quote { quoter = ""
|
|||
data QuoteDB = QuoteDB
|
||||
{ nextQuoteId :: QuoteID
|
||||
, quoteBotDB :: M.Map QuoteID Quote
|
||||
, lockedQuotes :: M.Map QuoteID (IRC.UserName, ClockTime)
|
||||
, lastActive :: M.Map IRC.Channel QuoteID
|
||||
, lockedQuotes :: M.Map QuoteID (IRC.UserName, UTCTime)
|
||||
, lastActive :: M.Map IRC.Channel (QuoteID, UTCTime)
|
||||
} deriving (Show, Typeable)
|
||||
|
||||
emptyQuoteDB :: QuoteDB
|
||||
emptyQuoteDB = QuoteDB { nextQuoteId = 0
|
||||
, quoteBotDB = M.empty
|
||||
, lockedQuotes = M.empty
|
||||
, lastActive = Nothing }
|
||||
, lastActive = M.empty }
|
||||
|
||||
$(deriveSafeCopy 0 'base ''QuoteElt)
|
||||
$(deriveSafeCopy 0 'base ''Quote)
|
||||
|
@ -70,7 +71,7 @@ getQuoteDB = asks quoteBotDB
|
|||
|
||||
-- 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
|
||||
theQuote <- asks quoteBotDB >>= return . M.lookup quoteId
|
||||
case theQuote of
|
||||
|
@ -80,11 +81,11 @@ isQuoteLockedFor quoteId requestor now = do
|
|||
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?
|
||||
else return . Right $ (addUTCTime 300 lockStamp > now) -- Is the entry older than 5 min?
|
||||
Nothing -> return $ Right True
|
||||
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) }
|
||||
|
||||
$(makeAcidic ''QuoteDB ['getQuote, 'getQuoteDB, 'isQuoteLockedFor, 'lockQuoteIdFor])
|
||||
|
@ -107,7 +108,7 @@ quote = PluginId
|
|||
theQuote :: Plugin (Env IO) () -- TODO : an argument for the history size
|
||||
theQuote = do
|
||||
baseDir <- liftIO $ System.Environment.XDG.BaseDir.getUserDataDir "hsbot"
|
||||
statDB <- liftIO $ openAcidStateFrom (baseDir ++ "/quoteDB/") emptyQuoteDB
|
||||
quoteDB <- liftIO $ openAcidStateFrom (baseDir ++ "/quoteDB/") emptyQuoteDB
|
||||
forever $ readMsg >>= eval quoteDB
|
||||
where
|
||||
eval :: AcidState QuoteDB -> Message -> Plugin (Env IO) ()
|
||||
|
@ -115,34 +116,34 @@ theQuote = do
|
|||
| IRC.msg_command msg == "PRIVMSG" = do
|
||||
cmdArgs <- lift $ getCommand msg
|
||||
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
|
||||
answerMsg "quote delete QUOTEID [ELTID] :"
|
||||
answerMsg $ 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." ]
|
||||
answerMsg msg "quote delete QUOTEID [ELTID] :"
|
||||
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." ]
|
||||
"quote":"help":"quick":_ -> do
|
||||
answerMsg "quote [quick] QUOTEE [QUOTE] :"
|
||||
answerMsg $ 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 "
|
||||
, "provided this module lookup it's conversation history and records the "
|
||||
, "last sentence of QUOTEE." ]
|
||||
"quote":"help":"show":_ -> answerMsg "quote show { QUOTEID | random [MIN_SCORE] }"
|
||||
answerMsg msg "quote [quick] QUOTEE [QUOTE] :"
|
||||
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 "
|
||||
, "provided this module lookup it's conversation history and records the "
|
||||
, "last sentence of QUOTEE." ]
|
||||
"quote":"help":"show":_ -> answerMsg msg "quote show { QUOTEID | random [MIN_SCORE] }"
|
||||
"quote":"help":"stat":_ -> do
|
||||
answerMsg "quote stat"
|
||||
answerMsg " Compute statistics about the quote database : Most quoters, most quoted "
|
||||
answerMsg msg "quote stat"
|
||||
answerMsg msg " Compute statistics about the quote database : Most quoters, most quoted "
|
||||
"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 }" ]
|
||||
"quote":"help":_ -> answerMsg "Invalid help topic."
|
||||
"quote":"help":_ -> answerMsg msg "Invalid help topic."
|
||||
"quote":_ -> answerMsg msg "Invalid quote command."
|
||||
"vote":"help":"quick":_ -> do
|
||||
answerMsg "vote [quick] [QUOTEID] { +1 | -1 | ++ | -- }"
|
||||
answerMsg $ 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 --." ]
|
||||
"vote":"help":[] -> answerMsg $ concat [ "Usage: vote { [quick] [QUOTEID] { +1 | -1 } | show [QUOTEID] | stat }"
|
||||
"vote":"help":_ -> answerMsg "Invalid help topic."
|
||||
answerMsg msg "vote [quick] [QUOTEID] { +1 | -1 | ++ | -- }"
|
||||
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 --." ]
|
||||
"vote":"help":[] -> answerMsg msg "Usage: vote { [quick] [QUOTEID] { +1 | -1 } | show [QUOTEID] | stat }"
|
||||
"vote":"help":_ -> answerMsg msg "Invalid help topic."
|
||||
"vote":_ -> answerMsg msg "Invalid vote command."
|
||||
_ -> return ()
|
||||
| otherwise = return ()
|
||||
eval _ _ _ _ = return ()
|
||||
eval _ _ = return ()
|
||||
|
||||
|
|
|
@ -25,6 +25,7 @@ Library
|
|||
Hsbot.Plugin
|
||||
Hsbot.Plugin.Duck
|
||||
Hsbot.Plugin.Ping
|
||||
Hsbot.Plugin.Quote
|
||||
Hsbot.Types
|
||||
Hsbot.Utils
|
||||
Extensions: DeriveDataTypeable FlexibleContexts ScopedTypeVariables
|
||||
|
@ -44,6 +45,7 @@ Library
|
|||
safecopy,
|
||||
tls >= 0.6.1,
|
||||
tls-extra >= 0.2.0,
|
||||
time,
|
||||
xdg-basedir
|
||||
|
||||
|
||||
|
|
Reference in a new issue