From: Joachim Breitner <mail@joachim-breitner.de>
Date: Sat, 5 Jul 2008 23:19:57 +0000 (+0000)
Subject: Stats Bot
X-Git-Url: http://git.nomeata.de/?p=darcs-mirror-haskell-partty.git;a=commitdiff_plain;h=d6975e182eedd71b5579c852b4433a9b0d1383fc;hp=970b6ae152fc2c7e96ba2c2379384548e3294e17;ds=sidebyside

Stats Bot
---

diff --git a/Partty.hs b/Partty.hs
index a96629d..56f4432 100644
--- a/Partty.hs
+++ b/Partty.hs
@@ -20,12 +20,15 @@ module Partty
 
 	, send
 	, say
+
+	, statsMain
 	)
 where
 
 import qualified Data.Map as M
 import Data.Map (Map)
 import Data.List
+import Data.Maybe
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Writer
@@ -303,8 +306,8 @@ parseIncomingMessage msg = case id of
        int3 = read (param_s !! 2) :: Int
 
        parsePlayer str = read (words str !! 2)
-       parseScore str = (read (words str !! 2), read (words str !! 2))
-       parseName str = (read (words str !! 2), read (words str !! 2))
+       parseScore str  = (read (words str !! 2), read (words str !! 3))
+       parseName str   = (read (words str !! 2), read (words str !! 3))
 
        lineEater :: Int -> ([String] -> IncomingMessage) -> IncomingMessage
        lineEater n f = ComplexInput $ \h ps -> do lines <- sequence (replicate n (hGetLine h))
@@ -425,3 +428,59 @@ say :: (MonadIO m, MonadReader ParttyState m) => String -> m ()
 say s = do 
 	name <- asks psLoginName
 	liftIO $ putStrLn $ "[" ++ name ++ "] " ++ s
+
+	
+statsMain  :: FilePath -> IO ()
+statsMain file = do
+	[host,port_s,username,password] <- getArgs
+
+	h <- connectTo host (PortNumber (fromIntegral (read port_s)))
+	hSetBuffering h LineBuffering
+	putStrLn $ "[" ++ username ++ "] Connected to " ++ host
+	InternalMessage Welcome <- parseIncomingMessage `liftM` hGetLine h
+	hPutStrLn h $ unwords ["login", username, password]
+	InternalMessage (PlayerJoined myName) <- parseIncomingMessage `liftM` hGetLine h
+
+	lastStats <- readFile file
+	when (lastStats == lastStats) $ return ()
+	
+	let dummyState = ParttyState
+		{ psMyName      = "0"
+		, psLoginName   = username
+		, psDay 	= 0
+		, psPlayerInfo	= error "psPlayerInfo not implemented"
+		, psHistory     = []
+		, psHintHistory = []
+		, psPlace       = 1
+		, psPlayers	= []
+		, psPlayersHere	= []
+		, psActionsLeft = 0
+		, psPartyPlace  = Nothing
+		, psFriends     = []
+		}
+	fix (\loop -> do (msg,_) <- getNextMessage h dummyState
+			 case msg of 
+			  (InternalMessage (GameStarting)) -> return ()
+			  otherwise                        -> loop
+		         )
+
+	fix (\loop score -> do
+	    this <- fix (\loop players points -> do
+			(msg,_) <- getNextMessage h dummyState
+			case msg of 
+			 (InternalMessage (NameList l)) -> loop l points
+			 (InternalMessage (ScoreList l))-> loop players l
+			 (InternalMessage (GameStarting))-> return $ merge players points
+			 otherwise                      -> loop players points
+		        ) undefined undefined
+	    let next = this : score
+	    putStrLn $ "Score: " ++ show this
+	    putStrLn "Writing score..."
+	    writeFile file (show next)
+	    loop next
+	    ) (read lastStats)
+
+ where merge player scores = map (
+ 		\(p1,n) -> (n, fromJust (lookup p1 scores))
+		) player
+	
diff --git a/Stats.hs b/Stats.hs
new file mode 100644
index 0000000..883c340
--- /dev/null
+++ b/Stats.hs
@@ -0,0 +1,3 @@
+import Partty
+
+main = statsMain "stats.out"