gameServer/OfficialServer/GameReplayStore.hs
author unc0rr
Tue, 19 Feb 2013 22:45:02 +0400
branchwebgl
changeset 8446 c18ba8726f5a
parent 8423 8aa450f6cf2c
child 8479 8d71109b04d2
permissions -rw-r--r--
Fix sources so pas2c written in haskell could render them again
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    10
import Data.Unique
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    11
import Control.Monad
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    12
---------------
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    13
import CoreTypes
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    14
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
    15
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
    16
saveReplay :: RoomInfo -> IO ()
8423
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    17
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
    18
    let gi = fromJust $ gameInfo r
8423
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    19
    when (allPlayersHaveRegisteredAccounts gi) $ do
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    20
        time <- getCurrentTime
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    21
        u <- liftM hashUnique newUnique
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    22
        let fileName = "replays/" ++ show time ++ "-" ++ show u
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    23
        let replayInfo = (teamsAtStart gi, Map.toList $ mapParams r, Map.toList $ params r, roundMsgs gi)
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    24
        E.catch
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    25
            (writeFile fileName (show replayInfo))
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    26
            (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e)