gore-and-ash-sync-1.2.0.1: Gore&Ash module for high level network synchronization

Copyright(c) Anton Gushcha, 2015-2016
LicenseBSD3
Maintainerncrashed@gmail.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone
LanguageHaskell2010

Game.GoreAndAsh.Sync.Module

Contents

Description

 

Synopsis

Documentation

newtype SyncT s m a Source #

Monad transformer of sync core module.

s
- State of next core module in modules chain;
m
- Next monad in modules monad stack;
a
- Type of result value;

How to embed module:

type AppStack = ModuleStack [LoggingT, NetworkT, ActorT, SyncT, ... other modules ... ] IO

-- | Current GHC (7.10.3) isn't able to derive this
instance SyncMonad AppMonad where
  getSyncIdM = AppMonad . getSyncIdM
  getSyncTypeRepM = AppMonad . getSyncTypeRepM
  registerSyncIdM = AppMonad . registerSyncIdM
  addSyncTypeRepM a b = AppMonad $ addSyncTypeRepM a b
  syncScheduleMessageM peer ch i mt msg  = AppMonad $ syncScheduleMessageM peer ch i mt msg
  syncSetLoggingM = AppMonad . syncSetLoggingM
  syncSetRoleM = AppMonad . syncSetRoleM
  syncGetRoleM = AppMonad syncGetRoleM
  syncRequestIdM a b = AppMonad $ syncRequestIdM a b

newtype AppMonad a = AppMonad (AppStack a)
  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, LoggingMonad, MonadThrow, MonadCatch, NetworkMonad, ActorMonad)

The module is NOT pure within first phase (see ModuleStack docs), therefore currently only IO end monad can handler the module.

Constructors

SyncT 

Fields

Instances

MonadTrans (SyncT s) Source # 

Methods

lift :: Monad m => m a -> SyncT s m a #

Monad m => MonadState (SyncState s) (SyncT s m) Source # 

Methods

get :: SyncT s m (SyncState s)

put :: SyncState s -> SyncT s m ()

state :: (SyncState s -> (a, SyncState s)) -> SyncT s m a

Monad m => Monad (SyncT s m) Source # 

Methods

(>>=) :: SyncT s m a -> (a -> SyncT s m b) -> SyncT s m b #

(>>) :: SyncT s m a -> SyncT s m b -> SyncT s m b #

return :: a -> SyncT s m a #

fail :: String -> SyncT s m a #

Functor m => Functor (SyncT s m) Source # 

Methods

fmap :: (a -> b) -> SyncT s m a -> SyncT s m b #

(<$) :: a -> SyncT s m b -> SyncT s m a #

MonadFix m => MonadFix (SyncT s m) Source # 

Methods

mfix :: (a -> SyncT s m a) -> SyncT s m a #

Monad m => Applicative (SyncT s m) Source # 

Methods

pure :: a -> SyncT s m a #

(<*>) :: SyncT s m (a -> b) -> SyncT s m a -> SyncT s m b #

(*>) :: SyncT s m a -> SyncT s m b -> SyncT s m b #

(<*) :: SyncT s m a -> SyncT s m b -> SyncT s m a #

MonadIO m => MonadIO (SyncT s m) Source # 

Methods

liftIO :: IO a -> SyncT s m a #

MonadMask m => MonadMask (SyncT s m) Source # 

Methods

mask :: ((forall a. SyncT s m a -> SyncT s m a) -> SyncT s m b) -> SyncT s m b

uninterruptibleMask :: ((forall a. SyncT s m a -> SyncT s m a) -> SyncT s m b) -> SyncT s m b

MonadThrow m => MonadThrow (SyncT s m) Source # 

Methods

throwM :: Exception e => e -> SyncT s m a

MonadCatch m => MonadCatch (SyncT s m) Source # 

Methods

catch :: Exception e => SyncT s m a -> (e -> SyncT s m a) -> SyncT s m a

MonadIO m => SyncMonad (SyncT s m) Source # 

Methods

getSyncIdM :: HashableTypeRep -> SyncT s m (Maybe Word64) Source #

getSyncTypeRepM :: Word64 -> SyncT s m (Maybe HashableTypeRep) Source #

registerSyncIdM :: HashableTypeRep -> SyncT s m Word64 Source #

addSyncTypeRepM :: HashableTypeRep -> Word64 -> SyncT s m () Source #

syncScheduleMessageM :: (NetworkMonad (SyncT s m), LoggingMonad (SyncT s m), NetworkMessage i, Serialize (NetworkMessageType i)) => Peer -> ChannelID -> i -> MessageType -> NetworkMessageType i -> SyncT s m () Source #

syncSetLoggingM :: Bool -> SyncT s m () Source #

syncSetRoleM :: SyncRole -> SyncT s m () Source #

syncGetRoleM :: SyncT s m SyncRole Source #

syncRequestIdM :: (ActorMonad (SyncT s m), NetworkMonad (SyncT s m), LoggingMonad (SyncT s m), NetworkMessage i) => Peer -> proxy i -> SyncT s m () Source #

type ModuleState (SyncT s m) Source # 
type ModuleState (SyncT s m) = SyncState s

registerSyncIdInternal :: HashableTypeRep -> SyncState s -> (Word64, SyncState s) Source #

Internal implementation of actor registrarion when monadic context isn't in scope

addSyncTypeRepInternal :: HashableTypeRep -> Word64 -> SyncState s -> SyncState s Source #

Internal implementation of actor registrarion when monadic context isn't in scope

syncRequestIdInternal :: forall proxy i m s. (ActorMonad m, NetworkMonad m, LoggingMonad m, NetworkMessage i) => Peer -> proxy i -> SyncState s -> m (SyncState s) Source #

Internal implementation of sending service request for actor net id

getServiceChannel :: NetworkMonad m => m ChannelID Source #

Return channel id 1 if network module has more than 1 channel, either fallback to 0

Note: If you open more than one channel, the module would use chanel id 1 as service channel, therefore count of channels on client and server should match (server won't response on channel 1 if it doesn't have it).

syncLog :: LoggingMonad m => SyncState s -> Text -> m () Source #

Log only when flag is turned on

Orphan instances

(NetworkMonad m, LoggingMonad m, ActorMonad m, GameModule m s) => GameModule (SyncT s m) (SyncState s) Source # 

Associated Types

type ModuleState (SyncT s m :: * -> *) :: *

Methods

runModule :: MonadIO m' => SyncT s m a -> SyncState s -> m' (a, SyncState s)

newModuleState :: MonadIO m' => m' (SyncState s)

withModule :: Proxy (* -> *) (SyncT s m) -> IO a -> IO a

cleanupModule :: SyncState s -> IO ()