Stats Bot

diff --git a/Partty.hs b/Partty.hs
index a96629d..56f4432 100644 (file)
--- 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 (file)
index 0000000..883c340
--- /dev/null
+++ b/Stats.hs
@@ -0,0 +1,3 @@
+import Partty
+
+main = statsMain "stats.out"