author | unc0rr |
Mon, 04 Feb 2013 00:13:55 +0400 | |
changeset 8479 | 8d71109b04d2 |
parent 8423 | 8aa450f6cf2c |
child 8482 | 5656a73fe3c3 |
permissions | -rw-r--r-- |
5143
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
1 |
{-# LANGUAGE ScopedTypeVariables #-} |
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
2 |
module OfficialServer.GameReplayStore where |
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
3 |
|
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
4 |
import Data.Time |
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
5 |
import Control.Exception as E |
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
6 |
import qualified Data.Map as Map |
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
7 |
import Data.Sequence() |
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
8 |
import System.Log.Logger |
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5143
diff
changeset
|
9 |
import Data.Maybe |
6040 | 10 |
import Data.Unique |
11 |
import Control.Monad |
|
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
12 |
import Data.List |
6040 | 13 |
--------------- |
14 |
import CoreTypes |
|
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
15 |
import EngineInteraction |
6040 | 16 |
|
5143
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
17 |
|
649d87819682
Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff
changeset
|
18 |
saveReplay :: RoomInfo -> IO () |
8423 | 19 |
saveReplay r = do |
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5143
diff
changeset
|
20 |
let gi = fromJust $ gameInfo r |
8423 | 21 |
when (allPlayersHaveRegisteredAccounts gi) $ do |
22 |
time <- getCurrentTime |
|
23 |
u <- liftM hashUnique newUnique |
|
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
24 |
let fileName = "replays/" ++ show time ++ "-" ++ show u ++ "." ++ show (roomProto r) |
8423 | 25 |
let replayInfo = (teamsAtStart gi, Map.toList $ mapParams r, Map.toList $ params r, roundMsgs gi) |
26 |
E.catch |
|
27 |
(writeFile fileName (show replayInfo)) |
|
28 |
(\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e) |
|
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
29 |
|
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
30 |
|
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
31 |
loadReplay :: Int -> IO [B.ByteString] |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
32 |
loadReplay p = E.handle (\(e :: SomeException) -> warningM "REPLAYS" $ "Problems reading replay") $ do |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
33 |
files <- liftM (isSuffixOf ('.' : show p)) getDirectoryContents |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
34 |
if (not $ null files) then |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
35 |
loadFile $ head files |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
36 |
else |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
37 |
return [] |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
38 |
where |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
39 |
loadFile fileName = E.handle (\(e :: SomeException) -> warningM "REPLAYS" $ "Problems reading " ++ fileName) $ do |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
40 |
(teams, params1, params2, roundMsgs) <- liftM read $ readFile fileName |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8423
diff
changeset
|
41 |
return $ replayToDemo teams (Map.fromList params1) (Map.fromList params2) roundMsgs |