module Game.LambdaHack.Server.Action.ActionType
( ActionSer, executorSer
) where
import Control.Applicative
import qualified Control.Monad.IO.Class as IO
import Control.Monad.Trans.State.Strict hiding (State)
import qualified Data.EnumMap.Strict as EM
import Data.Maybe
import System.FilePath
import Game.LambdaHack.Common.Action
import Game.LambdaHack.Common.ClientCmd
import qualified Game.LambdaHack.Common.Save as Save
import Game.LambdaHack.Common.State
import Game.LambdaHack.Server.Action.ActionClass
import Game.LambdaHack.Server.Config
import Game.LambdaHack.Server.State
data SerState = SerState
{ serState :: !State
, serServer :: !StateServer
, serDict :: !ConnServerDict
, serToSave :: !(Save.ChanSave (State, StateServer))
}
newtype ActionSer a = ActionSer {runActionSer :: StateT SerState IO a}
deriving (Monad, Functor, Applicative)
instance MonadActionRO ActionSer where
getState = ActionSer $ gets serState
getsState f = ActionSer $ gets $ f . serState
instance MonadAction ActionSer where
modifyState f =
ActionSer $ modify $ \serS -> serS {serState = f $ serState serS}
putState s =
ActionSer $ modify $ \serS -> serS {serState = s}
instance MonadServer ActionSer where
getServer = ActionSer $ gets serServer
getsServer f = ActionSer $ gets $ f . serServer
modifyServer f =
ActionSer $ modify $ \serS -> serS {serServer = f $ serServer serS}
putServer s =
ActionSer $ modify $ \serS -> serS {serServer = s}
liftIO = ActionSer . IO.liftIO
saveServer = ActionSer $ do
s <- gets serState
ser <- gets serServer
toSave <- gets serToSave
IO.liftIO $ Save.saveToChan toSave (s, ser)
instance MonadConnServer ActionSer where
getDict = ActionSer $ gets serDict
getsDict f = ActionSer $ gets $ f . serDict
modifyDict f =
ActionSer $ modify $ \serS -> serS {serDict = f $ serDict serS}
putDict s =
ActionSer $ modify $ \serS -> serS {serDict = s}
executorSer :: ActionSer () -> IO ()
executorSer m =
let saveFile (_, ser) =
configAppDataDir (sconfig ser)
</> fromMaybe "save" (ssavePrefixSer (sdebugSer ser))
<.> saveName
exe toSave =
evalStateT (runActionSer m)
SerState { serState = emptyState
, serServer = emptyStateServer
, serDict = EM.empty
, serToSave = toSave
}
in Save.wrapInSaves saveFile exe