adyxax/hsbot
Archived
1
0
Fork 0
Code Issues Activity

Added persistent statistics for the duck Module.

Browse source
This commit is contained in:
Julien Dessaux 2011-05-14 00:42:37 +02:00
parent 81fb522dd4
commit 1995f4ddb8
2 changed files with 87 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

96
Hsbot/Plugin/Duck.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE TypeFamilies, DeriveDataTypeable, TemplateHaskell #-}
-- | This module is an IRC plugin that generates and kills ducks
module Hsbot.Plugin.Duck
( duck
@ -5,16 +6,65 @@ module Hsbot.Plugin.Duck
) where
import Control.Concurrent
import qualified Data.List as L
import Control.Monad.Reader
import Control.Monad.State
import Data.Acid
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe
import Data.SafeCopy
import Data.Typeable
import qualified Network.IRC as IRC
import Prelude hiding (catch)
import System.Environment.XDG.BaseDir
import System.Random
import Hsbot.Message
import Hsbot.Types
import Hsbot.Utils
-- | A user statistic
data Stat = Stat
{ statRounds :: Int
, statShot :: Int
, statKilled :: Int
} deriving (Show, Typeable)
-- | Default values for new stat
emptyStat :: Stat
emptyStat = Stat { statRounds = 0
, statShot = 0
, statKilled = 0 }
-- The statistics database
data StatDB = StatDB
{ nickStats :: M.Map String Stat
} deriving (Show, Typeable)
-- | Statistics database initial state
emptyStatDB :: StatDB
emptyStatDB = StatDB { nickStats = M.empty }
$(deriveSafeCopy 0 'base ''Stat)
$(deriveSafeCopy 0 'base ''StatDB)
-- | Statistics database transactions
scoreAction :: String -> Int -> Int -> Int -> Update StatDB ()
scoreAction sender rounds shots kills = do
statDB <- get
let stats = nickStats statDB
stat = fromMaybe emptyStat $ M.lookup sender stats
stat' = stat { statRounds = rounds + statRounds stat
, statShot = shots + statShot stat
, statKilled = kills + statKilled stat }
put statDB { nickStats = M.insert sender stat' stats }
getDuckStats :: Query StatDB StatDB
getDuckStats = ask
-- This will define @ViewMessage@ and @AddMessage@ for us.
$(makeAcidic ''StatDB ['getDuckStats, 'scoreAction])
-- | The duck plugin identity
duck :: PluginId
duck = PluginId
@ -24,35 +74,39 @@ duck = PluginId
-- | An IRC plugin that generates and kills ducks
theDuck :: String -> Int -> Plugin (Env IO) ()
theDuck channel seconds = do
baseDir <- liftIO $ System.Environment.XDG.BaseDir.getUserDataDir "hsbot"
statDB <- liftIO $ openAcidStateFrom (baseDir ++ "/duckDB/") emptyStatDB
ducksMVar <- liftIO newEmptyMVar
duckSpawner channel seconds ducksMVar
forever $ readMsg >>= eval ducksMVar
forever $ readMsg >>= eval statDB ducksMVar
where
eval :: MVar Int -> Message -> Plugin (Env IO) ()
eval ducksMVar (IncomingMsg msg)
eval :: AcidState StatDB -> MVar Int -> Message -> Plugin (Env IO) ()
eval statDB ducksMVar (IncomingMsg msg)
| IRC.msg_command msg == "PRIVMSG" = do
-- First we kill the ducks that we find in the message
let kills = howManyDucksInThere . concat $ IRC.msg_params msg
when (kills /= "") $ answerMsg msg kills
-- Then we check if someone shot some duck
let shots = howManyBulletFiredInThere . concat $ IRC.msg_params msg
noDucksToShot <- liftIO $ isEmptyMVar ducksMVar
when (and [getDestination msg == channel, not noDucksToShot, shots > 0]) $ do
-- TODO: score dead ducks (with a min (ducksWaitingForDeath, shots))
ducksWaitingForDeath <- liftIO $ modifyMVar ducksMVar (\x -> return (x - shots, x))
when (shots >= ducksWaitingForDeath) $ do
_ <- liftIO $ takeMVar ducksMVar
duckSpawner channel seconds ducksMVar
-- TODO : score lost bullets and round
return ()
noDucksToShoot <- liftIO $ isEmptyMVar ducksMVar
when (shots > 0) $ do
_ <- update' statDB (ScoreAction (getSender msg) 0 shots 0)
when (and [getDestination msg == channel, not noDucksToShoot]) $ do
ducksWaitingForDeath <- liftIO $ modifyMVar ducksMVar (\x -> return (x - shots, x))
_ <- update' statDB (ScoreAction (getSender msg) 0 0 (min ducksWaitingForDeath shots))
when (shots >= ducksWaitingForDeath) $ do
_ <- liftIO $ takeMVar ducksMVar
duckSpawner channel seconds ducksMVar
_ <- update' statDB (ScoreAction (getSender msg) 1 0 0)
return ()
-- Finally we check if we received some command
cmdArgs <- lift $ getCommand msg
case cmdArgs of
--"ducks":"stats":args -> TODO
"ducks":"stats":_ -> query' statDB GetDuckStats >>= printDuckStats channel
"ducks":_ -> answerMsg msg "Invalid duck command."
_ -> return ()
| otherwise = return ()
eval _ _ = return ()
eval _ _ _ = return ()
-- | Regularly spawns ducks on a channel, just waiting to be shot
duckSpawner :: String -> Int -> MVar Int -> Plugin (Env IO) ()
@ -98,3 +152,15 @@ ducks = [ x : y : z | x <- nose, y <- face, z <- ["__/", "_/", "/"] ]
bangs :: [String]
bangs = [ "PAN", "PAN!" ]
-- | Nicely prints duck statistics
printDuckStats :: String -> StatDB -> Plugin (Env IO) ()
printDuckStats channel statDB = do
sendLine "Duck slaughter simulator - Hall of Fame"
mapM_ (sendLine . buildLine) $ M.toList (nickStats statDB)
where
buildLine :: (String, Stat) -> String
buildLine (nick, stat) = concat [ nick, ": ", show $ statRounds stat, " rounds won, ", show $ statShot stat
, " shots fired, ", show $ statKilled stat, " ducks killed" ]
sendLine :: String -> Plugin (Env IO) ()
sendLine msg = writeMsg . OutgoingMsg $ IRC.Message Nothing "PRIVMSG" [channel, msg]

9
hsbot.cabal
View file

@ -1,5 +1,5 @@
Name: hsbot
Version: 0.4.14
Version: 0.4.15
Cabal-version: >=1.2
Synopsis: A multipurposes IRC bot
Description:
@ -28,7 +28,8 @@ Library
Hsbot.Types
Hsbot.Utils
Extensions: DeriveDataTypeable FlexibleContexts ScopedTypeVariables
Build-depends: base >= 4.1 && < 5,
Build-depends: acid-state,
base >= 4.1 && < 5,
bytestring,
certificate,
containers,
@ -40,8 +41,10 @@ Library
mtl,
network,
random,
safecopy,
tls >= 0.6.1,
tls-extra >= 0.2.0
tls-extra >= 0.2.0,
xdg-basedir
Executable hsbot