eventsource-api-1.2.0: Provides an eventsourcing high level API.

Copyright(C) 2017 Yorick Laupa
License(see the file LICENSE)
MaintainerYorick Laupa <yo.eight@gmail.com>
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

EventSource.Aggregate

Contents

Description

Implementation of an aggregate abstraction. Link: https://en.wikipedia.org/wiki/Domain-driven_design.

Synopsis

Documentation

class StreamId a where Source #

Maps an id to a StreamName.

Minimal complete definition

toStreamName

Aggregate

class Aggregate a where Source #

Represents a stream aggregate. An aggregate can rebuild its internal state by replaying all the stream's events that aggregate is responsible for.

Minimal complete definition

apply

Associated Types

type Id a :: * Source #

Type of the id associated to the aggregate.

type Evt a :: * Source #

Type of event handled by the aggregate.

type M a :: * -> * Source #

Type of monad stack used by the aggregate.

Methods

apply :: a -> Evt a -> M a a Source #

Given current aggregate state, updates it according to the event the aggregate receives.

Instances

AggregateIO event state => Aggregate (Simple id command event state) Source # 

Associated Types

type Id (Simple id command event state) :: * Source #

type Evt (Simple id command event state) :: * Source #

type M (Simple id command event state) :: * -> * Source #

Methods

apply :: Simple id command event state -> Evt (Simple id command event state) -> M (Simple id command event state) (Simple id command event state) Source #

class Aggregate a => Validate a where Source #

Represents an aggregate that support validation. An aggregate that supports validation can receive command and decide if it was valid or not. When the validation is successful, The aggregate emits an event that will be persisted and pass to apply function.

Minimal complete definition

validate

Associated Types

type Cmd a :: * Source #

Type of command supported by the aggregate.

type Err a :: * Source #

Type of error that aggregate can yield.

Methods

validate :: a -> Cmd a -> M a (Decision a) Source #

Validates a command. If the command validation succeeds, it will emits an event. Otherwise, it will returns an error.

Instances

ValidateIO command event state => Validate (Simple id command event state) Source # 

Associated Types

type Cmd (Simple id command event state) :: * Source #

type Err (Simple id command event state) :: * Source #

Methods

validate :: Simple id command event state -> Cmd (Simple id command event state) -> M (Simple id command event state) (Decision (Simple id command event state)) Source #

type Decision a = Either (Err a) (Evt a) Source #

When validating a command, tells if the command was valid. If the command is valid, it returns an event. Otherwise, it returns an error.

data Agg a Source #

A stream aggregate. An aggregate updates its internal based on the event it receives. You can read its current state by using snapshot. If it supports validation, through Validated typeclass, it can receive command and emits an event if the command was successful. Otherwise, it will yield an error. When receiving valid command, an aggregate will persist the resulting event. An aggregate is only responsible of its own stream.

aggId :: Agg a -> Id a Source #

Returns an aggregate id.

runAgg :: MonadBase IO (M a) => Agg a -> Action a r -> (r -> M a ()) -> M a () Source #

Executes an action on an aggregate.

newAgg :: (Aggregate a, MonadBaseControl IO (M a)) => SomeStore -> Id a -> a -> M a (Agg a) Source #

Creates a new aggregate given an eventstore handle, an id and an initial state.

loadAgg :: (Aggregate a, StreamId (Id a), DecodeEvent (Evt a), MonadBaseControl IO (M a)) => SomeStore -> Id a -> a -> M a (Either ForEventFailure (Agg a)) Source #

Creates an aggregate and replays its entire stream to rebuild its internal state.

loadOrCreateAgg :: (Aggregate a, StreamId (Id a), DecodeEvent (Evt a), MonadBaseControl IO (M a)) => SomeStore -> Id a -> a -> M a (Agg a) Source #

Like loadAgg but call loadAgg in case of ForEventFailure error.

Interactions

submitCmd :: (Validate a, MonadBase IO (M a), StreamId (Id a), EncodeEvent (Evt a)) => Agg a -> Cmd a -> M a (Decision a) Source #

Submits a command to the aggregate. If the command was valid, it returns an event otherwise an error. In case of a valid command, the aggregate persist the resulting event to the eventstore. The aggregate will also update its internal state accordingly.

submitEvt :: (Aggregate a, MonadBase IO (M a)) => Agg a -> Evt a -> M a () Source #

Submits an event. The aggregate will update its internal state accondingly.

snapshot :: MonadBase IO (M a) => Agg a -> M a a Source #

Returns current aggregate state.

route :: MonadBase IO (M a) => Agg a -> (SomeStore -> a -> (a -> r -> M a ()) -> M a ()) -> M a r Source #

Uses usually by Root aggregates which usually have unusual workflow and make great use of a CPS-ed computation. http://blog.sapiensworks.com/post/2016/07/14/DDD-Aggregate-Decoded-1

closeAgg :: Agg a -> M a () Source #

Closes internal aggregate state.

execute :: MonadBase IO (M a) => Agg a -> Action a r -> M a r Source #

Executes an action.

Internal

newtype Action' e s m a Source #

Internal aggregate action. An action is executed by an aggregate. An action embodies fundamental operations like submitting event, validating command or returning the current snapshot of an aggregate. Action are CPS-ed encoded so the execution model can be flexible. An action can perform synchronously or asynchronously.

Constructors

Action' 

Fields

  • runAction :: e -> s -> (s -> a -> m ()) -> m ()
     

Instances

MonadTrans (Action' e s) Source # 

Methods

lift :: Monad m => m a -> Action' e s m a #

Monad (Action' e s m) Source # 

Methods

(>>=) :: Action' e s m a -> (a -> Action' e s m b) -> Action' e s m b #

(>>) :: Action' e s m a -> Action' e s m b -> Action' e s m b #

return :: a -> Action' e s m a #

fail :: String -> Action' e s m a #

Functor (Action' e s m) Source # 

Methods

fmap :: (a -> b) -> Action' e s m a -> Action' e s m b #

(<$) :: a -> Action' e s m b -> Action' e s m a #

Applicative (Action' e s m) Source # 

Methods

pure :: a -> Action' e s m a #

(<*>) :: Action' e s m (a -> b) -> Action' e s m a -> Action' e s m b #

liftA2 :: (a -> b -> c) -> Action' e s m a -> Action' e s m b -> Action' e s m c #

(*>) :: Action' e s m a -> Action' e s m b -> Action' e s m b #

(<*) :: Action' e s m a -> Action' e s m b -> Action' e s m a #

type Action a r = Action' (AggEnv a) (AggState a) (M a) r Source #

An action configured to aggregate internal types.

askEnv :: Action' e s m e Source #

Returns an action environment.

getState :: Action' e s m s Source #

Returns an action current state.

putState :: s -> Action' e s m () Source #

Set an action state.

data AggEnv a Source #

Aggregate internal environment.

Constructors

AggEnv 

Fields

data AggState a Source #

Aggregate internal state.

Constructors

AggState 

Fields

persist :: (StreamId id, EncodeEvent event, MonadBase IO m) => SomeStore -> id -> ExpectedVersion -> event -> m EventNumber Source #

Persists an event to the eventstore.