cqrs 0.9.0 → 0.9.1
raw patch · 13 files changed
+7/−620 lines, 13 filesdep −HUnitdep −SafeSemaphoredep −async
Dependencies removed: HUnit, SafeSemaphore, async, bytestring, conduit, containers, cqrs, cqrs-test, cqrs-types, deepseq, hspec, pool-conduit, random, stm, transformers
Files
- cqrs.cabal +7/−55
- src-test/Main.hs +0/−11
- src/Data/CQRS/Command.hs +0/−32
- src/Data/CQRS/EventStore/Backend/Memory.hs +0/−73
- src/Data/CQRS/GUID.hs +0/−5
- src/Data/CQRS/Internal/AggregateRef.hs +0/−65
- src/Data/CQRS/Internal/EventBus.hs +0/−40
- src/Data/CQRS/Internal/EventStore.hs +0/−37
- src/Data/CQRS/Internal/Repository.hs +0/−84
- src/Data/CQRS/Internal/UnitOfWork.hs +0/−183
- src/Data/CQRS/Query.hs +0/−19
- src/Data/CQRS/Repository.hs +0/−11
- src/Data/CQRS/Serializable.hs +0/−5
cqrs.cabal view
@@ -1,7 +1,12 @@ Name: cqrs-Version: 0.9.0+Version: 0.9.1 Synopsis: Command-Query Responsibility Segregation-Description: Haskell implementation of the CQRS architectural pattern.+Description:+ __This package has is OBSOLETE.__+ .+ Use <http://hackage.haskell.org/package/cqrs-core cqrs-core>+ instead!+ License: MIT License-file: LICENSE Category: Data@@ -12,58 +17,5 @@ Library Build-Depends: base == 4.*- , bytestring >= 0.9.0.1- , conduit >= 1.0 && < 2- , containers >= 0.5- , cqrs-types >= 0.9.0 && < 0.10- , deepseq >= 1.3 && < 2- , random >= 1.0 && < 1.1- , pool-conduit >= 0.1 && < 0.2- , SafeSemaphore >= 0.9 && < 1.0- , stm >= 2.4 && < 3- , transformers >= 0.2.2 && < 0.4 Default-language: Haskell2010- Default-Extensions: DeriveDataTypeable- ExistentialQuantification- GeneralizedNewtypeDeriving- MultiParamTypeClasses- PackageImports- ScopedTypeVariables- ghc-options: -Wall hs-source-dirs: src- Exposed-modules: Data.CQRS.Command- Data.CQRS.EventStore.Backend.Memory- Data.CQRS.GUID- Data.CQRS.Repository- Data.CQRS.Query- Data.CQRS.Serializable- Other-modules: Data.CQRS.Internal.AggregateRef- Data.CQRS.Internal.EventBus- Data.CQRS.Internal.EventStore- Data.CQRS.Internal.Repository- Data.CQRS.Internal.UnitOfWork--Test-Suite cqrs-tests- Type: exitcode-stdio-1.0- Hs-source-dirs: src-test- Main-is: Main.hs- Build-depends: base == 4.*- , async >= 2.0.1 && < 3- , bytestring >= 0.9.0.1- , conduit >= 0.5 && < 0.6- , pool-conduit >= 0.1 && < 0.2- , stm >= 2.4 && < 3- , transformers >= 0.2.2 && < 0.4- -- Self-dependency- , cqrs- , cqrs-test >= 0.9 && < 0.10- -- Test framework- , hspec >= 1.3 && < 2.0- , HUnit >= 1.2 && < 2.0- Ghc-options: -Wall- Default-language: Haskell2010- Default-extensions: DeriveDataTypeable- MultiParamTypeClasses- OverloadedStrings- ScopedTypeVariables- TemplateHaskell
− src-test/Main.hs
@@ -1,11 +0,0 @@-import Test.Hspec-import Data.CQRS.TransactionTest-import Data.CQRS.RepositoryTest-import Data.CQRS.EventStore.Backend.MemoryTest--main :: IO ()-main = do- hspec $ do- memoryTest- transactionTest- repositoryTest
− src/Data/CQRS/Command.hs
@@ -1,32 +0,0 @@-{-| Module to import for the "Command" side of the application. -}-module Data.CQRS.Command- ( -- Aggregate:- Aggregate- -- AggregateRef:- , AggregateRef- -- Eventable:- , Eventable(..)- -- EventStoreBackend:- , EventStoreBackend- -- GUID:- , GUID- , newGUID- -- Repository:- , Repository- -- UnitOfWork:- , UnitOfWorkT- , createAggregate- , createOrLoadAggregate- , findAggregate- , loadAggregate- , publishEvent- , runUnitOfWorkT- ) where--import Data.CQRS.Aggregate (Aggregate)-import Data.CQRS.Internal.AggregateRef (AggregateRef)-import Data.CQRS.Internal.UnitOfWork-import Data.CQRS.Internal.Repository (Repository)-import Data.CQRS.Eventable (Eventable(..))-import Data.CQRS.EventStore.Backend (EventStoreBackend)-import Data.CQRS.GUID (GUID, newGUID)
− src/Data/CQRS/EventStore/Backend/Memory.hs
@@ -1,73 +0,0 @@--- | Memory-based event store backend. Used primarily--- for testing.-module Data.CQRS.EventStore.Backend.Memory- ( MemoryEventStoreBackend- , createBackendPool- ) where---- External imports-import Control.Concurrent.STM (atomically)-import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar, writeTVar)-import Control.Concurrent.MSem as MSem-import Control.Monad (unless, liftM)-import Control.Monad.IO.Class (liftIO)-import qualified Data.Conduit.List as CL-import Data.Conduit.Pool (Pool, createPool)-import qualified Data.Foldable as F-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as M-import Data.Sequence (Seq, (><))-import qualified Data.Sequence as S---- Internal imports-import Data.CQRS.GUID-import Data.CQRS.EventStore.Backend---- | Memory-based event store backend.-data MemoryEventStoreBackend = MESB- (TVar (Map GUID (Seq RawEvent)))- (MSem Int)- (TVar (Map GUID RawSnapshot))---- | Pool of memory event store backends.-createBackendPool :: Int -> IO (Pool MemoryEventStoreBackend)-createBackendPool n = do- -- New "backing store" for every pool.- events <- atomically $ newTVar M.empty- snapshots <- atomically $ newTVar M.empty- lock <- MSem.new 1- -- Create the pool- createPool (return $ MESB events lock snapshots) (\_ -> return ()) 1 1 n---- Instance-instance EventStoreBackend MemoryEventStoreBackend where-- esbStoreEvents (MESB eventsTVar _ _) g v0 newEvents =- atomically $ do- events <- readTVar eventsTVar- let eventsForAggregate = M.findWithDefault S.empty g events- let expectedV0 = S.length eventsForAggregate- unless (expectedV0 == v0) $ fail "Mismatched version numbers"- writeTVar eventsTVar $ M.insert g (eventsForAggregate >< S.fromList newEvents) events-- esbRetrieveEvents (MESB eventsTVar _ _) g v0 = do- e <- liftIO $ atomically $ do- events <- readTVar eventsTVar- return $ F.toList $ M.findWithDefault S.empty g events- CL.sourceList $ drop v0 e-- esbEnumerateAllEvents (MESB eventsTVar _ _) = do- events <- liftIO $ atomically $ readTVar eventsTVar- CL.sourceList $ concatMap F.toList $ M.elems $ events-- esbWriteSnapshot (MESB _ _ v) g s =- atomically $ do- snapshots <- readTVar v- writeTVar v $ M.insert g s $ snapshots-- esbGetLatestSnapshot (MESB _ _ v) g =- atomically $ do- liftM (M.lookup g) $ readTVar v-- esbWithTransaction (MESB _ lock _) io =- MSem.with lock io
− src/Data/CQRS/GUID.hs
@@ -1,5 +0,0 @@-module Data.CQRS.GUID- ( module G- ) where--import "cqrs-types" Data.CQRS.GUID as G
− src/Data/CQRS/Internal/AggregateRef.hs
@@ -1,65 +0,0 @@-module Data.CQRS.Internal.AggregateRef- ( AggregateRef- , arGUID- , arSnapshotVersion- , arStartVersion- , getCurrentVersion- , mkAggregateRef- , publishEvent- , readEvents- , readValue- ) where--import Control.DeepSeq (NFData, ($!!))-import Control.Monad (liftM)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.CQRS.Eventable (Eventable(..))-import Data.CQRS.GUID (GUID)-import Data.CQRS.PersistedEvent (PersistedEvent(..))-import Data.Foldable (toList)-import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)-import Data.Sequence (Seq, (|>))-import qualified Data.Sequence as S-import Data.Typeable (Typeable)---- | Aggregate root reference.-data AggregateRef a e =- AggregateRef { arValue :: IORef (Maybe a)- , arEvents :: IORef (Seq (PersistedEvent e))- , arGUID :: !GUID- , arStartVersion :: !Int- , arSnapshotVersion :: !Int- }- deriving (Typeable)---- | Make aggregate-mkAggregateRef :: (MonadIO m) => Maybe a -> GUID -> Int -> Int -> m (AggregateRef a e)-mkAggregateRef a guid originatingVersion snapshotVersion = do- a' <- liftIO $ newIORef a- e' <- liftIO $ newIORef S.empty- return $ AggregateRef a' e' guid originatingVersion snapshotVersion---- | Publish event to aggregate.-publishEvent :: (MonadIO m, Eventable a e, NFData e, NFData a) => AggregateRef a e -> e -> m ()-publishEvent aggregateRef event = liftIO $ do- -- Apply event to aggregate state.- a <- readIORef $ arValue aggregateRef- let a' = applyEvent a $!! event- writeIORef (arValue aggregateRef) $!! a'- -- Add event to aggregate.- modifyIORef' (arEvents aggregateRef) $ \events -> do- (events |>) $!! (PersistedEvent (arGUID aggregateRef) event (arStartVersion aggregateRef + 1 + S.length events))---- | Read aggregate events.-readEvents :: (MonadIO m) => AggregateRef a e -> m [PersistedEvent e]-readEvents = liftM toList . liftIO . readIORef . arEvents---- | Read aggregate state.-readValue :: (MonadIO m) => AggregateRef a e -> m (Maybe a)-readValue = liftIO . readIORef . arValue---- | Get the current version of the aggregate in aggregate ref.-getCurrentVersion :: (MonadIO m) => AggregateRef a e -> m Int-getCurrentVersion a = do- nevs <- liftM S.length $ liftIO $ readIORef $ arEvents a- return $ nevs + (arStartVersion a)
− src/Data/CQRS/Internal/EventBus.hs
@@ -1,40 +0,0 @@-module Data.CQRS.Internal.EventBus- ( EventBus(..)- , Subscription(..)- , newEventBus- ) where---- External imports-import Control.Concurrent.STM (atomically)-import qualified Control.Concurrent.STM.TChan as C-import Control.DeepSeq (NFData, ($!!))-import Control.Monad.IO.Class (MonadIO, liftIO)---- Internal imports-import Data.CQRS.PersistedEvent---- | Event bus that broadcasts events of a certain type.-data EventBus e = EventBus- { publishEventsToBus :: [PersistedEvent e] -> IO ()- , subscribeToEventBus :: IO (Subscription e)- , unsubscribeFromEventBus :: Subscription e -> IO ()- }---- | A subscription to an event bus.-newtype Subscription e = Subscription- { readEventFromSubscription :: IO [PersistedEvent e]- }---- | Create a new event bus.-newEventBus :: (MonadIO m, Show e, NFData e) => m (EventBus e)-newEventBus = do- c <- liftIO $ atomically $ C.newBroadcastTChan- let publish events = do- atomically $ C.writeTChan c $!! events- subscribe = do- c' <- atomically $ C.dupTChan c- return $ Subscription (atomically $ C.readTChan c')- unsubscribe _ = do- -- TODO: Should we set a flag to detect post-unsubscribe use?- return () -- Needs no cleanup.- return $ EventBus publish subscribe unsubscribe
− src/Data/CQRS/Internal/EventStore.hs
@@ -1,37 +0,0 @@--- | Event store functions.-module Data.CQRS.Internal.EventStore- ( EventStore(..)- , enumerateEventStore- , retrieveEvents- , storeEvents- ) where---- External imports-import Data.ByteString (ByteString)-import Data.Conduit (ResourceT, Source, ($=))-import qualified Data.Conduit.List as CL--- Internal imports-import Data.CQRS.EventStore.Backend-import Data.CQRS.GUID-import Data.CQRS.Serializable-import Data.CQRS.PersistedEvent (PersistedEvent(..))---- Provide a type alias.-data EventStore e b = EventStore { esBackend :: b }--enumerateEventStore :: forall e b . (Serializable e, EventStoreBackend b) => EventStore e b -> Source (ResourceT IO) [PersistedEvent e]-enumerateEventStore es =- esbEnumerateAllEvents (esBackend es) $= CL.map (\re -> [fmap deserialize' re])--storeEvents :: (Serializable e, EventStoreBackend b) => EventStore e b -> GUID -> Int -> [PersistedEvent e] -> IO ()-storeEvents (EventStore esb) guid v0 evs = do- esbStoreEvents esb guid v0 $ (map $ fmap $ serialize) evs--retrieveEvents :: (Serializable e, EventStoreBackend b) => EventStore e b -> GUID -> Int -> Source (ResourceT IO) (PersistedEvent e)-retrieveEvents (EventStore esb) guid v0 = (esbRetrieveEvents esb guid v0) $= (CL.map (fmap deserialize'))--deserialize' :: Serializable e => ByteString -> e-deserialize' s =- case deserialize s of- Nothing -> error "Could not deserialize event -- event deserialization MUST NOT fail"- Just e -> e
− src/Data/CQRS/Internal/Repository.hs
@@ -1,84 +0,0 @@-module Data.CQRS.Internal.Repository- ( Repository(..)- , Settings(..)- , defaultSettings- , enumerateEventStore- , enumerateAndStreamEvents- , newRepository- , withEventStoreBackend- ) where---- External imports-import Control.DeepSeq (NFData)-import Control.Monad (forever)-import Control.Monad.Trans.Class (lift)-import Data.Conduit (ResourceT, Source, addCleanup, bracketP, yield)-import Data.Conduit.Pool (Pool, withResource, takeResource, mrReuse, mrValue)---- Internal imports-import Data.CQRS.Internal.EventBus-import qualified Data.CQRS.Internal.EventStore as ES-import Data.CQRS.Internal.EventStore (EventStore(..))-import Data.CQRS.EventStore.Backend-import Data.CQRS.PersistedEvent-import Data.CQRS.Serializable---- | Repository settings-data Settings = Settings- { settingsSnapshotFrequency :: Maybe Int- }---- | Default repository settings.-defaultSettings :: Settings-defaultSettings = Settings- { settingsSnapshotFrequency = Nothing- }---- | Repository consisting of an event store and an event bus.-data Repository e b = Repository- { repositoryEventStoreBackendPool :: Pool b -- ^ Event store backend pool- , repositoryEventBus :: EventBus e -- ^ Event bus to use- , repositorySettings :: Settings -- ^ Repository settings- }---- | Create a repository from a pool of event store backends.-newRepository :: (EventStoreBackend b, Show e, NFData e) => Settings -> Pool b -> IO (Repository e b)-newRepository settings eventStoreBackendPool = do- eventBus <- newEventBus- return $ Repository { repositoryEventStoreBackendPool = eventStoreBackendPool- , repositoryEventBus = eventBus- , repositorySettings = settings- }---- | Use event store backed from repository to perform an action.-withEventStoreBackend :: (EventStoreBackend b) => Repository e b -> (b -> IO a) -> IO a-withEventStoreBackend (Repository p _ _) action =- withResource p (\eventStoreBackend -> action eventStoreBackend)---- | Enumerate all events which satisfy certain criteria from event--- store associated with repository.-enumerateEventStore :: (Serializable e, EventStoreBackend b) => Repository e b -> Source (ResourceT IO) [PersistedEvent e]-enumerateEventStore (Repository p _ _) = do- eventStoreBackend <- lift $ takeResource p- addCleanup (mrReuse eventStoreBackend) $ ES.enumerateEventStore (EventStore $ mrValue eventStoreBackend)---- State for the streaming thread.-data StreamingState e = Buffering [PersistedEvent e]- | EnumerationComplete [PersistedEvent e]- | Streaming- deriving (Show)---- | Enumerate all events which satisfy criteria and stream--- all new events from repository. All events which arrive--- while enumerating are buffered until enumeration completes.-enumerateAndStreamEvents :: (Show e, Serializable e, EventStoreBackend b) => Repository e b -> Source (ResourceT IO) [PersistedEvent e]-enumerateAndStreamEvents repository@(Repository _ eventBus _) = do- bracketP (subscribeToEventBus eventBus)- (unsubscribeFromEventBus eventBus)- (\subscription -> do- enumerateEventStore repository- subscriptionSource subscription)- where- subscriptionSource subscription = forever $ do- e <- lift $ lift $ readEventFromSubscription subscription- yield e
− src/Data/CQRS/Internal/UnitOfWork.hs
@@ -1,183 +0,0 @@--- | Run commands against repositories.-module Data.CQRS.Internal.UnitOfWork- ( UnitOfWorkT- , createAggregate- , createOrLoadAggregate- , findAggregate- , loadAggregate- , publishEvent- , runUnitOfWorkT- ) where---- External imports-import Control.DeepSeq (NFData)-import Control.Monad (forM, when)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Class (MonadTrans(..), lift)-import Control.Monad.Trans.State (StateT, get, modify, runStateT)-import Data.Conduit (($$), runResourceT)-import qualified Data.Conduit.List as CL-import Data.Foldable (forM_)-import Data.List (find)-import Data.Typeable (Typeable, cast)---- Internal imports-import Data.CQRS.Aggregate-import Data.CQRS.Eventable (Eventable(..))-import Data.CQRS.Internal.EventBus-import Data.CQRS.EventStore.Backend (EventStoreBackend(..), RawSnapshot(..))-import Data.CQRS.GUID (GUID)-import Data.CQRS.Internal.AggregateRef (AggregateRef, mkAggregateRef)-import qualified Data.CQRS.Internal.AggregateRef as AR-import Data.CQRS.Internal.EventStore (EventStore(..))-import qualified Data.CQRS.Internal.EventStore as ES-import Data.CQRS.Internal.Repository-import Data.CQRS.PersistedEvent (PersistedEvent(..))-import Data.CQRS.Serializable---- | UnitOfWork monad transformer.-newtype UnitOfWorkT e m a = UnitOfWorkT (UnitOfWorkM e m a)- deriving (Functor, Monad)--instance MonadTrans (UnitOfWorkT e) where- lift m = UnitOfWorkT $ lift m---- Existential wrapper for AggregateRef.-data BoxedAggregateRef e =- forall a . (Typeable a, Typeable e, Serializable e, Aggregate a, Eventable a e) => BoxedAggregateRef (AggregateRef a e)---- Existential wrapper for event store.-data BoxedEventStore e =- forall b . (EventStoreBackend b) => BoxedEventStore (EventStore e b)---- Existential wrapper for event store backend-data BoxedEventStoreBackend =- forall b . (EventStoreBackend b) => BoxedEventStoreBackend b---- | UnitOfWork monad.-type UnitOfWorkM e = StateT (UnitOfWork e)--data UnitOfWork e =- UnitOfWork { txnEventStore :: BoxedEventStore e- , txnEventStoreBackend :: BoxedEventStoreBackend- , aggregateRefsToCommit :: [BoxedAggregateRef e]- }---- | Run transaction against an event store.-runUnitOfWorkT :: forall b c e . (Typeable e, Serializable e, EventStoreBackend b) => Repository e b -> UnitOfWorkT e IO c -> IO c-runUnitOfWorkT repository (UnitOfWorkT transaction) = do- (r, writtenEvents) <- withEventStoreBackend repository $ \eventStoreBackend -> do- esbWithTransaction eventStoreBackend $ do- -- Run the computation.- let eventStore = EventStore eventStoreBackend- (r,s) <- runStateT transaction $ UnitOfWork (BoxedEventStore eventStore) (BoxedEventStoreBackend eventStoreBackend) []- -- Write out all the aggregates.- writtenEvents <- forM (aggregateRefsToCommit s) $ \(BoxedAggregateRef a) -> do- -- Write out accumulated events.- evs <- AR.readEvents a- ES.storeEvents eventStore (AR.arGUID a) (AR.arStartVersion a) evs- -- If we've advanced N events past the last snapshot, we- -- create a new snapshot.- forM_ (settingsSnapshotFrequency $ repositorySettings repository) $ \f -> do- v <- AR.getCurrentVersion a- when (v - AR.arSnapshotVersion a > f) $ do- mav <- AR.readValue a- case mav of- Just av ->- esbWriteSnapshot eventStoreBackend (AR.arGUID a) $ RawSnapshot v $ serialize av- Nothing ->- return ()- -- Return the written events for accumulator- return $ evs- -- Return the value.- return (r, concat writtenEvents)- -- Publish- publishEventsToBus (repositoryEventBus repository) writtenEvents- -- Return command return value- return r---- Get an aggregate ref by GUID.-getById :: forall a e . (Typeable a, Typeable e, Serializable e, Aggregate a, Eventable a e) => GUID -> UnitOfWorkT e IO (AggregateRef a e)-getById guid = UnitOfWorkT $ do- -- Check through list to see if we've given out a reference to the aggregate before.- aggregateRefs <- fmap aggregateRefsToCommit get- case find (\(BoxedAggregateRef a) -> AR.arGUID a == guid) aggregateRefs of- Just (BoxedAggregateRef a) ->- case cast a of- Just (a' :: AggregateRef a e) -> return a'- Nothing ->- -- This cast could only really fail if there are duplicate GUIDs for- -- different types of aggregates/events.- fail $ concat ["Duplicate GUID ", show guid, "!" ]- Nothing -> do- getByIdFromEventStore guid---- Get the latest snapshot from database, filling in a default--- if a) no snapshot exists, or b) snapshot state was not decodable.-getLatestSnapshot :: forall a e . (Typeable a, Typeable e, Serializable e, Aggregate a) => GUID -> UnitOfWorkM e IO (Int, Maybe a)-getLatestSnapshot guid = do- (BoxedEventStoreBackend eventStoreBackend) <- fmap txnEventStoreBackend get- r <- liftIO $ esbGetLatestSnapshot eventStoreBackend guid- case r of- Just (RawSnapshot v a) -> do- case deserialize a :: Maybe a of- Just a' -> return (v, Just a')- Nothing -> return (0, Nothing)- Nothing -> do- return (0, Nothing)---- Retrieve aggregate from event store.-getByIdFromEventStore :: forall a e . (Typeable a, Typeable e, Serializable e, Aggregate a, Eventable a e) => GUID -> UnitOfWorkM e IO (AggregateRef a e)-getByIdFromEventStore guid = do- (BoxedEventStore es) <- fmap txnEventStore get- -- Get latest snapshot (if any).- (v0,ma0) <- getLatestSnapshot guid- -- Get events.- events <- lift $ runResourceT $ (ES.retrieveEvents es guid v0 $$ CL.consume)- let latestVersion = maximum $ (:) v0 (map peSequenceNumber events)- -- Build the aggregate state from all the events.- let a = foldl (\a0 e -> applyEvent a0 $ peEvent e) ma0 events- -- Make the aggregate itself- (a' :: AggregateRef a e) <- lift $ mkAggregateRef a guid latestVersion v0- -- Add to set of aggregates to commit later.- modify $ \s -> s { aggregateRefsToCommit = (BoxedAggregateRef a' : aggregateRefsToCommit s) }- -- Return the aggregate.- return $ a'---- | Publish event for an aggregate root.-publishEvent :: (MonadIO m, Serializable e, Typeable a, Typeable e, Aggregate a, Eventable a e, NFData a, NFData e) => AggregateRef a e -> e -> UnitOfWorkT e m ()-publishEvent aggregateRef event = UnitOfWorkT $ do- lift $ AR.publishEvent aggregateRef event---- | Find aggregate root.-findAggregate :: (Serializable e, Typeable a, Typeable e, Aggregate a, Eventable a e) => GUID -> UnitOfWorkT e IO (Maybe (AggregateRef a e, a))-findAggregate guid = do- aggregateRef <- getById guid- aggregate <- lift $ AR.readValue aggregateRef- case aggregate of- Nothing -> return Nothing- Just a -> return $ Just (aggregateRef, a)---- | Load aggregate root. The aggregate root must exist.-loadAggregate :: (Serializable e, Typeable a, Typeable e, Aggregate a, Eventable a e) => GUID -> UnitOfWorkT e IO (AggregateRef a e, a)-loadAggregate guid = do- mAggregate <- findAggregate guid- case mAggregate of- Nothing -> fail $ show $ "Aggregate with GUID " ++ show guid ++ " does not exist"- Just a -> return a---- | Add aggregate root. The aggregate root will be created upon--- transaction commit.-createAggregate :: (Serializable e, Typeable a, Typeable e, Aggregate a, Eventable a e) => GUID -> UnitOfWorkT e IO (AggregateRef a e)-createAggregate guid = do- aggregateRef <- getById guid- aggregate <- lift $ AR.readValue aggregateRef- case aggregate of- Nothing -> do- return aggregateRef- Just _ -> fail $ show $ "Aggregate with GUID " ++ show guid ++ " already exists"---- | Create or load aggregate. The aggregate root will be created (if necessary)--- upon transaction commit.-createOrLoadAggregate :: (Serializable e, Typeable a, Typeable e, Aggregate a, Eventable a e) => GUID -> UnitOfWorkT e IO (AggregateRef a e)-createOrLoadAggregate guid = getById guid
− src/Data/CQRS/Query.hs
@@ -1,19 +0,0 @@-module Data.CQRS.Query- ( -- cqrs-types:- PersistedEvent(..)- -- EventStoreBackend:- , EventStoreBackend- -- GUID:- , GUID- -- Repository:- , Repository- , enumerateAndStreamEvents- , enumerateEventStore- ) where--import "cqrs-types" Data.CQRS.PersistedEvent-import Data.CQRS.GUID (GUID)-import Data.CQRS.Internal.Repository (Repository,- enumerateEventStore,- enumerateAndStreamEvents)-import Data.CQRS.EventStore.Backend (EventStoreBackend)
− src/Data/CQRS/Repository.hs
@@ -1,11 +0,0 @@-module Data.CQRS.Repository- ( -- * Repository- Repository- , newRepository- -- * Settings- , Settings- , settingsSnapshotFrequency- , defaultSettings- ) where--import Data.CQRS.Internal.Repository
− src/Data/CQRS/Serializable.hs
@@ -1,5 +0,0 @@-module Data.CQRS.Serializable- ( module G- ) where--import "cqrs-types" Data.CQRS.Serializable as G