|
1 {-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} |
|
2 module Main where |
|
3 |
|
4 import Data.Maybe |
|
5 import Data.TConfig |
|
6 import qualified Data.ByteString.Char8 as B |
|
7 import Database.MySQL.Simple |
|
8 import Database.MySQL.Simple.QueryResults |
|
9 import Database.MySQL.Simple.Result |
|
10 import Control.Monad |
|
11 import Control.Exception |
|
12 import System.IO |
|
13 import qualified Data.Map as Map |
|
14 import Data.Time.Clock |
|
15 ------ |
|
16 import OfficialServer.Glicko2 |
|
17 |
|
18 |
|
19 queryEpochDates = "SELECT epoch, todatetime, todatetime + INTERVAL 1 week FROM rating_epochs WHERE epoch = (SELECT MAX(epoch) FROM rating_epochs)" |
|
20 queryPreviousRatings = "SELECT v.userid, v.rating, v.rd, v.volatility FROM rating_values as v WHERE (v.epoch = (SELECT MAX(epoch) FROM rating_epochs))" |
|
21 queryGameResults = |
|
22 "SELECT \ |
|
23 \ p.userid \ |
|
24 \ , p.place \ |
|
25 \ , COALESCE(vp.rating, 1500) \ |
|
26 \ , COALESCE(vp.rd, 350) \ |
|
27 \ , COALESCE(vp.volatility, 0.06) \ |
|
28 \ , COALESCE(vo.rating, 1500) \ |
|
29 \ , COALESCE(vo.rd, 350) \ |
|
30 \ , COALESCE(vo.volatility, 0.06) \ |
|
31 \ FROM \ |
|
32 \ (SELECT epoch, todatetime FROM rating_epochs WHERE epoch = (SELECT MAX(epoch) FROM rating_epochs)) as e \ |
|
33 \ JOIN rating_games as g ON (g.time BETWEEN e.todatetime AND e.todatetime + INTERVAL 1 WEEK - INTERVAL 1 SECOND) \ |
|
34 \ JOIN rating_players as p ON (p.gameid = g.id) \ |
|
35 \ JOIN rating_players as o ON (p.gameid = o.gameid AND p.userid <> o.userid AND (p.place = 0 OR (p.place <> o.place))) \ |
|
36 \ LEFT OUTER JOIN rating_values as vp ON (vp.epoch = e.epoch AND vp.userid = p.userid) \ |
|
37 \ LEFT OUTER JOIN rating_values as vo ON (vo.epoch = e.epoch AND vo.userid = o.userid) \ |
|
38 \ GROUP BY p.userid, p.gameid, p.place \ |
|
39 \ ORDER BY p.userid" |
|
40 insertNewRatings = "INSERT INTO rating_values (userid, epoch, rating, rd, volatility, games) VALUES (?, ?, ?, ?, ?, ?)" |
|
41 insertNewEpoch = "INSERT INTO rating_epochs (epoch, todatetime) VALUES (?, ?)" |
|
42 |
|
43 mergeRatingData :: Map.Map Int (RatingData, [GameData]) -> [(Int, (RatingData, [GameData]))] -> Map.Map Int (RatingData, [GameData]) |
|
44 mergeRatingData m s = foldr (uncurry (Map.insertWith mf)) m s |
|
45 where |
|
46 mf (rd, gds) (_, gds2) = (rd, gds ++ gds2) |
|
47 |
|
48 calculateRatings dbConn = do |
|
49 [(epochNum :: Int, fromDate :: UTCTime, toDate :: UTCTime)] <- query_ dbConn queryEpochDates |
|
50 initRatingData <- (Map.fromList . map fromDBrating) `fmap` query_ dbConn queryPreviousRatings |
|
51 gameData <- map fromGameResult `fmap` query_ dbConn queryGameResults |
|
52 let mData = map getNewRating . Map.toList $ mergeRatingData initRatingData gameData |
|
53 executeMany dbConn insertNewRatings $ map (toInsert epochNum) mData |
|
54 execute dbConn insertNewEpoch (epochNum + 1, toDate) |
|
55 return () |
|
56 where |
|
57 toInsert e (i, (g, RatingData r rd v)) = (i, e + 1, r, rd, v, g) |
|
58 getNewRating (a, d) = (a, uncurry calcNewRating d) |
|
59 convPlace :: Int -> Double |
|
60 convPlace 0 = 0.5 |
|
61 convPlace 1 = 1.0 |
|
62 convPlace 2 = 0.0 |
|
63 convPlace _ = error "Incorrect place value" |
|
64 fromDBrating (a, b, c, d) = (a, (RatingData b c d, [])) |
|
65 fromGameResult (pid, place, prating, pRD, pvol, orating, oRD, ovol) = |
|
66 (pid, |
|
67 (RatingData prating pRD pvol |
|
68 , [GameData (RatingData orating oRD ovol) $ convPlace place])) |
|
69 |
|
70 |
|
71 data DBConnectInfo = DBConnectInfo { |
|
72 dbHost |
|
73 , dbName |
|
74 , dbLogin |
|
75 , dbPassword :: B.ByteString |
|
76 } |
|
77 |
|
78 cfgFileName :: String |
|
79 cfgFileName = "hedgewars-server.ini" |
|
80 |
|
81 |
|
82 readServerConfig :: ConnectInfo -> IO ConnectInfo |
|
83 readServerConfig ci = do |
|
84 cfg <- readConfig cfgFileName |
|
85 return $ ci{ |
|
86 connectHost = value "dbHost" cfg |
|
87 , connectDatabase = value "dbName" cfg |
|
88 , connectUser = value "dbLogin" cfg |
|
89 , connectPassword = value "dbPassword" cfg |
|
90 } |
|
91 where |
|
92 value n c = fromJust2 n $ getValue n c |
|
93 fromJust2 n Nothing = error $ "Missing config entry " ++ n |
|
94 fromJust2 _ (Just a) = a |
|
95 |
|
96 dbConnectionLoop mySQLConnectionInfo = |
|
97 Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $ |
|
98 bracket |
|
99 (connect mySQLConnectionInfo) |
|
100 close |
|
101 calculateRatings |
|
102 |
|
103 main = readServerConfig defaultConnectInfo >>= dbConnectionLoop |