HAppS-State-0.9.2.1: Event-based distributed state.Source codeContentsIndex
HAppS.State
Contents
ACID monad
Types
Misc utilities
Random numbers
TH helpers
Serialization
Unsafe things
Synopsis
data Ev m t
type AnyEv a = forall t. (Monad (t STM), MonadTrans t) => Ev (t STM) a
data TxControl
query :: (MonadIO m, QueryEvent ev res) => ev -> m res
update :: (MonadIO m, UpdateEvent ev res) => ev -> m res
type Update state = Ev (StateT state STM)
type Query state = Ev (ReaderT state STM)
type TxId = Int64
type EpochMilli = Int64
data TxConfig = TxConfig {
txcCheckpointSeconds :: Seconds
txcOperationMode :: OperationMode
txcClusterSize :: Int
txcClusterPort :: Int
txcCommitFrequency :: Int
}
nullTxConfig :: TxConfig
data Saver
= NullSaver
| FileSaver String
| Queue Saver
| Memory (MVar Store)
setUpdateType :: Proxy t -> Update t ()
setQueryType :: Proxy t -> Query t ()
asUpdate :: Update t a -> Proxy t -> Update t a
asQuery :: Query t a -> Proxy t -> Query t a
askState :: Query st st
getState :: Update st st
putState :: st -> Update st ()
liftSTM :: STM a -> AnyEv a
class CatchEv m where
catchEv :: Ev m a -> (Exception -> a) -> Ev m a
sel :: (Env -> b) -> AnyEv b
localState :: (outer -> inner) -> (inner -> outer -> outer) -> Ev (StateT inner STM) a -> Ev (StateT outer STM) a
localStateReader :: (outer -> inner) -> Ev (ReaderT inner STM) a -> Ev (ReaderT outer STM) a
runQuery :: Query st a -> Update st a
getEventId :: Integral txId => AnyEv txId
getTime :: Integral epochTime => AnyEv epochTime
getEventClockTime :: AnyEv ClockTime
getRandom :: Random a => AnyEv a
getRandomR :: Random a => (a, a) -> AnyEv a
inferRecordUpdaters :: Name -> Q [Dec]
module HAppS.State.Control
runTxSystem :: (Methods st, Component st) => Saver -> Proxy st -> IO (MVar TxControl)
shutdownSystem :: MVar TxControl -> IO ()
module HAppS.State.ComponentTH
module HAppS.State.ComponentSystem
closeTxControl :: MVar TxControl -> IO ()
createCheckpoint :: MVar TxControl -> IO ()
unsafeIOToEv :: IO a -> AnyEv a
ACID monad
data Ev m t Source
Monad for ACID event handlers.
show/hide Instances
MonadReader st (Update st)
MonadReader st (Query st)
MonadState st (Update st)
Monad m => Monad (Ev m)
Monad m => Functor (Ev m)
MonadPlus m => MonadPlus (Ev m)
(Typeable state, Typeable t) => Typeable (Ev (StateT state STM) t)
(Typeable state, Typeable t) => Typeable (Ev (ReaderT state STM) t)
type AnyEv a = forall t. (Monad (t STM), MonadTrans t) => Ev (t STM) aSource
ACID computations that work with any state and event types.
data TxControl Source
query :: (MonadIO m, QueryEvent ev res) => ev -> m resSource
Emit a state query and wait for the result.
update :: (MonadIO m, UpdateEvent ev res) => ev -> m resSource
Schedule an update and wait for it to complete. When this function returns, you're guaranteed the update will be persistent.
type Update state = Ev (StateT state STM)Source
type Query state = Ev (ReaderT state STM)Source
Types
type TxId = Int64Source
type EpochMilli = Int64Source
data TxConfig Source
Constructors
TxConfig
txcCheckpointSeconds :: SecondsPerform checkpoint at least every N seconds.
txcOperationMode :: OperationMode
txcClusterSize :: IntNumber of active nodes in the cluster (not counting this node).
txcClusterPort :: Int
txcCommitFrequency :: IntCommits per second. Only applies to cluster mode.
nullTxConfig :: TxConfigSource
data Saver Source
Constructors
NullSaverA saver that discards all output
FileSaver StringA saver that operates on files. The parameter is the prefix for the files. Creates the prefix directory.
Queue SaverEnable queueing.
Memory (MVar Store)
Misc utilities
setUpdateType :: Proxy t -> Update t ()Source
Use a proxy to force the type of an update action.
setQueryType :: Proxy t -> Query t ()Source
Use a proxy to force the type of a query action.
asUpdate :: Update t a -> Proxy t -> Update t aSource
Currying version of setUpdateType.
asQuery :: Query t a -> Proxy t -> Query t aSource
Currying version of setQueryType.
askState :: Query st stSource
Specialized version of ask
getState :: Update st stSource
Specialized version of get
putState :: st -> Update st ()Source
Specialized version of put.
liftSTM :: STM a -> AnyEv aSource
Lift an STM action into Ev.
class CatchEv m whereSource
Methods
catchEv :: Ev m a -> (Exception -> a) -> Ev m aSource
show/hide Instances
sel :: (Env -> b) -> AnyEv bSource
Select a part of the environment.
localState :: (outer -> inner) -> (inner -> outer -> outer) -> Ev (StateT inner STM) a -> Ev (StateT outer STM) aSource

Run a computation with a local environment.

Run a computation with local state. Changes to state will be visible to outside.

localStateReader :: (outer -> inner) -> Ev (ReaderT inner STM) a -> Ev (ReaderT outer STM) aSource
Run a computation with local state.
runQuery :: Query st a -> Update st aSource
Execute a Query action in the Update monad.
getEventId :: Integral txId => AnyEv txIdSource
getTime :: Integral epochTime => AnyEv epochTimeSource
getEventClockTime :: AnyEv ClockTimeSource
Random numbers
getRandom :: Random a => AnyEv aSource
Get a random number.
getRandomR :: Random a => (a, a) -> AnyEv aSource
Get a random number inside the range.
TH helpers
inferRecordUpdaters :: Name -> Q [Dec]Source
Infer updating functions for a record a_foo :: component -> record -> record and withFoo = localState foo a_foo.
Serialization
module HAppS.State.Control
runTxSystem :: (Methods st, Component st) => Saver -> Proxy st -> IO (MVar TxControl)Source
Run a transaction system
shutdownSystem :: MVar TxControl -> IO ()Source
module HAppS.State.ComponentTH
module HAppS.State.ComponentSystem
closeTxControl :: MVar TxControl -> IO ()Source
createCheckpoint :: MVar TxControl -> IO ()Source
Unsafe things
unsafeIOToEv :: IO a -> AnyEv aSource
Produced by Haddock version 2.1.0