summaryrefslogtreecommitdiff
path: root/Hsbot
diff options
context:
space:
mode:
authorJulien Dessaux2011-05-14 00:42:37 +0200
committerJulien Dessaux2011-05-14 00:42:37 +0200
commit1995f4ddb8cedbd1f1d3f2b139546e09d200d579 (patch)
treee659913d98a0780a3c26f332c741c1777a92321f /Hsbot
parentAdded a function to get the sender of an irc message. (diff)
downloadhsbot-1995f4ddb8cedbd1f1d3f2b139546e09d200d579.tar.gz
hsbot-1995f4ddb8cedbd1f1d3f2b139546e09d200d579.tar.bz2
hsbot-1995f4ddb8cedbd1f1d3f2b139546e09d200d579.zip
Added persistent statistics for the duck Module.
Diffstat (limited to '')
-rw-r--r--Hsbot/Plugin/Duck.hs96
1 files changed, 81 insertions, 15 deletions
diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs
index afc9fa3..353dff2 100644
--- a/Hsbot/Plugin/Duck.hs
+++ b/Hsbot/Plugin/Duck.hs
@@ -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]
+