gameServer/OfficialServer/GameReplayStore.hs
author dag10
Mon, 21 Jan 2013 00:30:18 -0500
changeset 8415 02acf6b92f52
parent 8371 0551b5c3de9a
child 8423 8aa450f6cf2c
permissions -rw-r--r--
Moved room name edit box from footer to top of page. Also shows room name when in slave mode. Temporarily increased HWForm's min height from 580 to 610.
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 ()
8371
0551b5c3de9a - Start work on checker
unc0rr
parents: 6040
diff changeset
    17
saveReplay r = when allPlayersHaveRegisteredAccounts $ do
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
    18
    time <- getCurrentTime
6040
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    19
    u <- liftM hashUnique newUnique
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    20
    let fileName = "replays/" ++ show time ++ "-" ++ show u
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
    21
    let gi = fromJust $ gameInfo r
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
    22
    let replayInfo = (teamsAtStart gi, Map.toList $ mapParams r, Map.toList $ params r, roundMsgs gi)
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
    23
    E.catch
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
    24
        (writeFile fileName (show replayInfo))
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
    25
        (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e)