module Game.LambdaHack.Server.MonadServer
(
MonadServer( getsServer
, modifyServer
, chanSaveServer
, liftIO
)
, MonadServerAtomic(..)
, getServer, putServer, debugPossiblyPrint, debugPossiblyPrintAndExit
, serverPrint, saveServer, dumpRngs, restoreScore, registerScore
, rndToAction, getSetGen
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Paths_LambdaHack as Self (version)
import qualified Control.Exception as Ex
import qualified Control.Monad.Trans.State.Strict as St
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time.Clock.POSIX
import Data.Time.LocalTime
import System.Exit (exitFailure)
import System.FilePath
import System.IO (hFlush, stdout)
import qualified System.Random.SplitMix32 as SM
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.ClientOptions (sbenchmark)
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.File
import qualified Game.LambdaHack.Common.HighScore as HighScore
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import qualified Game.LambdaHack.Common.Save as Save
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Core.Random
import Game.LambdaHack.Server.ServerOptions
import Game.LambdaHack.Server.State
class MonadStateRead m => MonadServer m where
getsServer :: (StateServer -> a) -> m a
modifyServer :: (StateServer -> StateServer) -> m ()
chanSaveServer :: m (Save.ChanSave (State, StateServer))
liftIO :: IO a -> m a
class MonadServer m => MonadServerAtomic m where
execUpdAtomic :: UpdAtomic -> m ()
execUpdAtomicSer :: UpdAtomic -> m Bool
execUpdAtomicFid :: FactionId -> UpdAtomic -> m ()
execUpdAtomicFidCatch :: FactionId -> UpdAtomic -> m Bool
execSfxAtomic :: SfxAtomic -> m ()
execSendPer :: FactionId -> LevelId
-> Perception -> Perception -> Perception -> m ()
getServer :: MonadServer m => m StateServer
getServer :: m StateServer
getServer = (StateServer -> StateServer) -> m StateServer
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> StateServer
forall a. a -> a
id
putServer :: MonadServer m => StateServer -> m ()
putServer :: StateServer -> m ()
putServer StateServer
s = (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer (StateServer -> StateServer -> StateServer
forall a b. a -> b -> a
const StateServer
s)
debugPossiblyPrint :: MonadServer m => Text -> m ()
debugPossiblyPrint :: Text -> m ()
debugPossiblyPrint Text
t = do
Bool
debug <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
sdbgMsgSer (ServerOptions -> Bool)
-> (StateServer -> ServerOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> Text -> IO ()
T.hPutStr Handle
stdout (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
Handle -> IO ()
hFlush Handle
stdout
debugPossiblyPrintAndExit :: MonadServer m => Text -> m ()
debugPossiblyPrintAndExit :: Text -> m ()
debugPossiblyPrintAndExit Text
t = do
Bool
debug <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
sdbgMsgSer (ServerOptions -> Bool)
-> (StateServer -> ServerOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> Text -> IO ()
T.hPutStr Handle
stdout (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
Handle -> IO ()
hFlush Handle
stdout
IO ()
forall a. IO a
exitFailure
serverPrint :: MonadServer m => Text -> m ()
serverPrint :: Text -> m ()
serverPrint Text
t = IO () -> m ()
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> Text -> IO ()
T.hPutStr Handle
stdout (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
Handle -> IO ()
hFlush Handle
stdout
saveServer :: MonadServer m => m ()
saveServer :: m ()
saveServer = do
State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
StateServer
ser <- m StateServer
forall (m :: * -> *). MonadServer m => m StateServer
getServer
ChanSave (State, StateServer)
toSave <- m (ChanSave (State, StateServer))
forall (m :: * -> *).
MonadServer m =>
m (ChanSave (State, StateServer))
chanSaveServer
IO () -> m ()
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ChanSave (State, StateServer) -> (State, StateServer) -> IO ()
forall a. ChanSave a -> a -> IO ()
Save.saveToChan ChanSave (State, StateServer)
toSave (State
s, StateServer
ser)
dumpRngs :: MonadServer m => RNGs -> m ()
dumpRngs :: RNGs -> m ()
dumpRngs RNGs
rngs = IO () -> m ()
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> Text -> IO ()
T.hPutStr Handle
stdout (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$! RNGs -> Text
forall a. Show a => a -> Text
tshow RNGs
rngs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
Handle -> IO ()
hFlush Handle
stdout
restoreScore :: forall m. MonadServer m => COps -> m HighScore.ScoreDict
restoreScore :: COps -> m ScoreDict
restoreScore COps{RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} = do
Bool
benchmark <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
sbenchmark (ClientOptions -> Bool)
-> (StateServer -> ClientOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerOptions -> ClientOptions
sclientOptions (ServerOptions -> ClientOptions)
-> (StateServer -> ServerOptions) -> StateServer -> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
Maybe ScoreDict
mscore <- if Bool
benchmark then Maybe ScoreDict -> m (Maybe ScoreDict)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ScoreDict
forall a. Maybe a
Nothing else do
let scoresFile :: FilePath
scoresFile = RuleContent -> FilePath
rscoresFile RuleContent
corule
FilePath
dataDir <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO IO FilePath
appDataDir
let path :: FilePath -> FilePath
path FilePath
bkp = FilePath
dataDir FilePath -> FilePath -> FilePath
</> FilePath
bkp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
scoresFile
Bool
configExists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath -> FilePath
path FilePath
"")
Either SomeException (Maybe ScoreDict)
res <- IO (Either SomeException (Maybe ScoreDict))
-> m (Either SomeException (Maybe ScoreDict))
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO (Either SomeException (Maybe ScoreDict))
-> m (Either SomeException (Maybe ScoreDict)))
-> IO (Either SomeException (Maybe ScoreDict))
-> m (Either SomeException (Maybe ScoreDict))
forall a b. (a -> b) -> a -> b
$ IO (Maybe ScoreDict) -> IO (Either SomeException (Maybe ScoreDict))
forall e a. Exception e => IO a -> IO (Either e a)
Ex.try (IO (Maybe ScoreDict)
-> IO (Either SomeException (Maybe ScoreDict)))
-> IO (Maybe ScoreDict)
-> IO (Either SomeException (Maybe ScoreDict))
forall a b. (a -> b) -> a -> b
$
if Bool
configExists then do
(Version
vlib2, ScoreDict
s) <- FilePath -> IO (Version, ScoreDict)
forall b. Binary b => FilePath -> IO (Version, b)
strictDecodeEOF (FilePath -> FilePath
path FilePath
"")
if Version -> Version -> Bool
Save.compatibleVersion Version
vlib2 Version
Self.version
then Maybe ScoreDict -> IO (Maybe ScoreDict)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ScoreDict -> IO (Maybe ScoreDict))
-> Maybe ScoreDict -> IO (Maybe ScoreDict)
forall a b. (a -> b) -> a -> b
$! ScoreDict
s ScoreDict -> Maybe ScoreDict -> Maybe ScoreDict
`seq` ScoreDict -> Maybe ScoreDict
forall a. a -> Maybe a
Just ScoreDict
s
else do
let msg :: FilePath
msg =
FilePath
"High score file from incompatible version of game detected."
FilePath -> IO (Maybe ScoreDict)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
msg
else Maybe ScoreDict -> IO (Maybe ScoreDict)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ScoreDict
forall a. Maybe a
Nothing
FilePath
savePrefix <- (StateServer -> FilePath) -> m FilePath
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> FilePath) -> m FilePath)
-> (StateServer -> FilePath) -> m FilePath
forall a b. (a -> b) -> a -> b
$ ServerOptions -> FilePath
ssavePrefixSer (ServerOptions -> FilePath)
-> (StateServer -> ServerOptions) -> StateServer -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
let defPrefix :: FilePath
defPrefix = ServerOptions -> FilePath
ssavePrefixSer ServerOptions
defServerOptions
moveAside :: Bool
moveAside = FilePath
savePrefix FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
defPrefix
handler :: Ex.SomeException -> m (Maybe a)
handler :: SomeException -> m (Maybe a)
handler SomeException
e = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
moveAside (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
IO () -> m ()
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile (FilePath -> FilePath
path FilePath
"") (FilePath -> FilePath
path FilePath
"bkp.")
let msg :: Text
msg = Text
"High score restore failed."
Text -> Text -> Text
<+> (if Bool
moveAside
then Text
"The wrong file moved aside."
else Text
"")
Text -> Text -> Text
<+> Text
"The error message is:"
Text -> Text -> Text
<+> ([Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines) (SomeException -> Text
forall a. Show a => a -> Text
tshow SomeException
e)
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
msg
Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
(SomeException -> m (Maybe ScoreDict))
-> (Maybe ScoreDict -> m (Maybe ScoreDict))
-> Either SomeException (Maybe ScoreDict)
-> m (Maybe ScoreDict)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> m (Maybe ScoreDict)
forall a. SomeException -> m (Maybe a)
handler Maybe ScoreDict -> m (Maybe ScoreDict)
forall (m :: * -> *) a. Monad m => a -> m a
return Either SomeException (Maybe ScoreDict)
res
m ScoreDict
-> (ScoreDict -> m ScoreDict) -> Maybe ScoreDict -> m ScoreDict
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ScoreDict -> m ScoreDict
forall (m :: * -> *) a. Monad m => a -> m a
return ScoreDict
HighScore.empty) ScoreDict -> m ScoreDict
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ScoreDict
mscore
registerScore :: MonadServer m => Status -> FactionId -> m ()
registerScore :: Status -> FactionId -> m ()
registerScore Status
status FactionId
fid = do
cops :: COps
cops@COps{RuleContent
corule :: RuleContent
corule :: COps -> RuleContent
corule} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Int
total <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Int) -> m Int) -> (State -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ (ItemBag, Int) -> Int
forall a b. (a, b) -> b
snd ((ItemBag, Int) -> Int)
-> (State -> (ItemBag, Int)) -> State -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> State -> (ItemBag, Int)
calculateTotal FactionId
fid
let scoresFile :: FilePath
scoresFile = RuleContent -> FilePath
rscoresFile RuleContent
corule
FilePath
dataDir <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO IO FilePath
appDataDir
ScoreDict
scoreDict <- COps -> m ScoreDict
forall (m :: * -> *). MonadServer m => COps -> m ScoreDict
restoreScore COps
cops
ContentId ModeKind
gameModeId <- (State -> ContentId ModeKind) -> m (ContentId ModeKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ContentId ModeKind
sgameModeId
Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
Int
dungeonTotal <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Int
sgold
POSIXTime
date <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
TimeZone
tz <- IO TimeZone -> m TimeZone
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO TimeZone -> m TimeZone) -> IO TimeZone -> m TimeZone
forall a b. (a -> b) -> a -> b
$ UTCTime -> IO TimeZone
getTimeZone (UTCTime -> IO TimeZone) -> UTCTime -> IO TimeZone
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
date
Challenge
curChalSer <- (StateServer -> Challenge) -> m Challenge
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Challenge) -> m Challenge)
-> (StateServer -> Challenge) -> m Challenge
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Challenge
scurChalSer (ServerOptions -> Challenge)
-> (StateServer -> ServerOptions) -> StateServer -> Challenge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
Bool
bench <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
sbenchmark (ClientOptions -> Bool)
-> (StateServer -> ClientOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerOptions -> ClientOptions
sclientOptions (ServerOptions -> ClientOptions)
-> (StateServer -> ServerOptions) -> StateServer -> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
Bool
noConfirmsGame <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
IntMap Int
sbandSpawned <- (StateServer -> IntMap Int) -> m (IntMap Int)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> IntMap Int
sbandSpawned
let fact :: Faction
fact = FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
path :: FilePath
path = FilePath
dataDir FilePath -> FilePath -> FilePath
</> FilePath
scoresFile
outputScore :: (Bool, (ScoreTable, Int)) -> m ()
outputScore (Bool
worthMentioning, (ScoreTable
ntable, Int
pos)) =
if Bool
bench Bool -> Bool -> Bool
|| Bool
noConfirmsGame Bool -> Bool -> Bool
|| Faction -> Bool
isAIFact Faction
fact then
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n"
([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ TimeZone -> Int -> ScoreRecord -> [Text]
HighScore.showScore TimeZone
tz Int
pos (Int -> ScoreTable -> ScoreRecord
HighScore.getRecord Int
pos ScoreTable
ntable)
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
" Spawned groups:"
Text -> Text -> Text
<+> [Text] -> Text
T.unwords ([Text] -> [Text]
forall a. [a] -> [a]
tail (Text -> [Text]
T.words (IntMap Int -> Text
forall a. Show a => a -> Text
tshow IntMap Int
sbandSpawned)))]
else
let nScoreDict :: ScoreDict
nScoreDict = ContentId ModeKind -> ScoreTable -> ScoreDict -> ScoreDict
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ContentId ModeKind
gameModeId ScoreTable
ntable ScoreDict
scoreDict
in Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
worthMentioning (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
FilePath -> Version -> ScoreDict -> IO ()
forall b. Binary b => FilePath -> Version -> b -> IO ()
encodeEOF FilePath
path Version
Self.version (ScoreDict
nScoreDict :: HighScore.ScoreDict)
chal :: Challenge
chal | Player -> Bool
fhasUI (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact = Challenge
curChalSer
| Bool
otherwise = Challenge
curChalSer
{cdiff :: Int
cdiff = Int -> Int
difficultyInverse (Challenge -> Int
cdiff Challenge
curChalSer)}
theirVic :: (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int)
theirVic (FactionId
fi, Faction
fa) | FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
fid Faction
fact FactionId
fi
Bool -> Bool -> Bool
&& Bool -> Bool
not (Faction -> Bool
isHorrorFact Faction
fa) = EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int)
forall a. a -> Maybe a
Just (EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int))
-> EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int)
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fa
| Bool
otherwise = Maybe (EnumMap (ContentId ItemKind) Int)
forall a. Maybe a
Nothing
theirVictims :: EnumMap (ContentId ItemKind) Int
theirVictims = (Int -> Int -> Int)
-> [EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int)
-> [EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int))
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int)
theirVic ([(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int])
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int]
forall a b. (a -> b) -> a -> b
$ FactionDict -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs FactionDict
factionD
ourVic :: (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int)
ourVic (FactionId
fi, Faction
fa) | FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fid Faction
fact FactionId
fi = EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int)
forall a. a -> Maybe a
Just (EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int))
-> EnumMap (ContentId ItemKind) Int
-> Maybe (EnumMap (ContentId ItemKind) Int)
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fa
| Bool
otherwise = Maybe (EnumMap (ContentId ItemKind) Int)
forall a. Maybe a
Nothing
ourVictims :: EnumMap (ContentId ItemKind) Int
ourVictims = (Int -> Int -> Int)
-> [EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int)
-> [EnumMap (ContentId ItemKind) Int]
-> EnumMap (ContentId ItemKind) Int
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int))
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe (EnumMap (ContentId ItemKind) Int)
ourVic ([(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int])
-> [(FactionId, Faction)] -> [EnumMap (ContentId ItemKind) Int]
forall a b. (a -> b) -> a -> b
$ FactionDict -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs FactionDict
factionD
table :: ScoreTable
table = ContentId ModeKind -> ScoreDict -> ScoreTable
HighScore.getTable ContentId ModeKind
gameModeId ScoreDict
scoreDict
registeredScore :: (Bool, (ScoreTable, Int))
registeredScore =
ScoreTable
-> Int
-> Int
-> Time
-> Status
-> POSIXTime
-> Challenge
-> Text
-> EnumMap (ContentId ItemKind) Int
-> EnumMap (ContentId ItemKind) Int
-> HiCondPoly
-> (Bool, (ScoreTable, Int))
HighScore.register ScoreTable
table Int
total Int
dungeonTotal Time
time Status
status POSIXTime
date Challenge
chal
([Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact)
EnumMap (ContentId ItemKind) Int
ourVictims EnumMap (ContentId ItemKind) Int
theirVictims
(Player -> HiCondPoly
fhiCondPoly (Player -> HiCondPoly) -> Player -> HiCondPoly
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact)
(Bool, (ScoreTable, Int)) -> m ()
outputScore (Bool, (ScoreTable, Int))
registeredScore
rndToAction :: MonadServer m => Rnd a -> m a
rndToAction :: Rnd a -> m a
rndToAction Rnd a
r = do
SMGen
gen1 <- (StateServer -> SMGen) -> m SMGen
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> SMGen
srandom
let (a
a, SMGen
gen2) = Rnd a -> SMGen -> (a, SMGen)
forall s a. State s a -> s -> (a, s)
St.runState Rnd a
r SMGen
gen1
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {srandom :: SMGen
srandom = SMGen
gen2}
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
getSetGen :: MonadServer m => Maybe SM.SMGen -> m SM.SMGen
getSetGen :: Maybe SMGen -> m SMGen
getSetGen Maybe SMGen
mrng = case Maybe SMGen
mrng of
Just SMGen
rnd -> SMGen -> m SMGen
forall (m :: * -> *) a. Monad m => a -> m a
return SMGen
rnd
Maybe SMGen
Nothing -> IO SMGen -> m SMGen
forall (m :: * -> *) a. MonadServer m => IO a -> m a
liftIO IO SMGen
SM.newSMGen