cqrs 0.3.0 → 0.4.0

raw patch · 6 files changed

+38/−39 lines, 6 filesdep +cerealPVP ok

version bump matches the API change (PVP)

Dependencies added: cereal

API changes (from Hackage documentation)

Files

• cqrs.cabal +2/−2
• src/Data/CQRS.hs +1/−3
• src/Data/CQRS/Event.hs +0/−16
• src/Data/CQRS/EventStore.hs +7/−0
• src/Data/CQRS/GUID.hs +11/−6
• src/Data/CQRS/Transaction.hs +17/−12

@@ -1,5 +1,5 @@ Name:                cqrs-Version:             0.3.0+Version:             0.4.0 Synopsis:            Command-Query Responsibility Segregation Description:         Haskell implementation of the CQRS architectural pattern.   An SQLite3-based backend is included.@@ -14,6 +14,7 @@ Library   Build-Depends: base == 4.*                , bytestring >= 0.9.0.1+               , cereal >= 0.3.3 && < 0.4                , containers >= 0.4                , data-default >= 0.3 && < 0.4                , direct-sqlite >= 1.1 && < 1.2@@ -32,7 +33,6 @@   Exposed-modules:     Data.CQRS                        Data.CQRS.Aggregate                        Data.CQRS.AggregateRef-                       Data.CQRS.Event                        Data.CQRS.Eventable                        Data.CQRS.EventStore                        Data.CQRS.EventStore.Sqlite3

@@ -3,7 +3,6 @@ module Data.CQRS         ( module Data.CQRS.Aggregate         , module Data.CQRS.AggregateRef-        , module Data.CQRS.Event         , module Data.CQRS.Eventable         , module Data.CQRS.GUID         , module Data.CQRS.Transaction@@ -11,7 +10,6 @@  import Data.CQRS.Aggregate import Data.CQRS.AggregateRef-import Data.CQRS.Event import Data.CQRS.Eventable-import Data.CQRS.GUID+import Data.CQRS.GUID(GUID, newGUID) import Data.CQRS.Transaction

@@ -1,16 +0,0 @@--- | Event type class. All events that can be applied to aggregate roots--- are required have an instance for this class.-module Data.CQRS.Event-       ( Event(..)-       ) where--import Data.ByteString (ByteString)---- | Event class.-class Event e where-  -- | Encode event into a strict ByteString.-  encodeEvent :: e -> ByteString-  -- | Decode event from a strict ByteString. To avoid corrupt-  -- event stores, any events that have ever been stored {b must}-  -- be decodable for all time.-  decodeEvent :: ByteString -> e

@@ -1,8 +1,10 @@ -- | Event store data types. module Data.CQRS.EventStore        ( EventStore(..)+       , withEventStore        ) where +import Control.Exception (bracket) import Data.ByteString (ByteString) import Data.CQRS.GUID @@ -40,3 +42,8 @@     -- | Close the event store.     closeEventStore :: IO ()     }++-- | Perform an IO action with an open event store.+withEventStore :: (IO EventStore) -> (EventStore -> IO a) -> IO a+withEventStore open action = bracket open closeEventStore action+

@@ -3,13 +3,15 @@        ( GUID        , fromByteString        , newGUID-       , nil        , toByteString        ) where +import           Control.Monad (liftM) import           Data.ByteString (ByteString) import qualified Data.ByteString as B import           Data.ByteString.Char8 ()+import           Data.Default (Default(..))+import           Data.Serialize (Serialize(..)) import           Data.Typeable (Typeable) import           Data.Word (Word8) import           System.Random (randomRIO)@@ -18,11 +20,9 @@ newtype GUID a = GUID ByteString               deriving (Show, Typeable, Eq) --- | The "nil" GUID. This is used for the root--- aggregate root which all other aggregate roots--- can be reached from.-nil :: GUID a-nil = GUID $ B.pack $ replicate 32 0+-- | Default GUID value.+instance Default (GUID a) where+    def = GUID $ B.pack $ replicate 32 0  -- | Get a random byte. randomWord8 :: IO Word8@@ -41,3 +41,8 @@ -- | Convert ByteString to GUID. fromByteString :: ByteString -> GUID a fromByteString s = GUID s++-- | Serialize instance.+instance Serialize (GUID a) where+    put = put . toByteString+    get = liftM fromByteString get

@@ -11,16 +11,17 @@ 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.ByteString (ByteString) import           Data.CQRS.Aggregate (Aggregate(..)) import           Data.CQRS.Internal.AggregateRef (AggregateRef, mkAggregateRef) import qualified Data.CQRS.Internal.AggregateRef as AR-import           Data.CQRS.Event (Event(..)) import           Data.CQRS.Eventable (Eventable(..)) import           Data.CQRS.EventStore (EventStore, withTransaction) import qualified Data.CQRS.EventStore as ES import           Data.CQRS.GUID (GUID) import           Data.Default (Default(..)) import           Data.List (find)+import           Data.Serialize (Serialize, decode, encode) import           Data.Typeable (Typeable, cast)  -- | Transaction monad transformer.@@ -32,7 +33,7 @@  -- Existential wrapper for AggregateRef. data BoxedAggregateRef e =-  forall a . (Typeable a, Typeable e, Event e, Default a, Aggregate a, Eventable a e) => BoxedAggregateRef (AggregateRef a e)+  forall a . (Typeable a, Typeable e, Serialize e, Default a, Aggregate a, Eventable a e) => BoxedAggregateRef (AggregateRef a e)  -- | Transaction monad itself. type Transaction e = StateT (TransactionState e)@@ -42,8 +43,12 @@                    , aggregateRefsToCommit :: [BoxedAggregateRef e]                    } +-- | Decode a serialized value "irrefutably".+decode' :: Serialize e => ByteString -> e+decode' = either error id . decode+ -- | Run transaction against an event store.-runTransactionT :: (Typeable e, Event e) => EventStore -> TransactionT e IO c -> IO c+runTransactionT :: (Typeable e, Serialize e) => EventStore -> TransactionT e IO c -> IO c runTransactionT eventStore_ (TransactionT transaction) = do   withTransaction eventStore_ $ do     -- Run the computation.@@ -52,7 +57,7 @@     forM_ (aggregateRefsToCommit s) $ \(BoxedAggregateRef a) -> do       es <- AR.readEvents a       ES.storeEvents eventStore_ (AR.arGUID a) (AR.arStartVersion a)-        (map encodeEvent es)+        (map encode es)       -- If we've advanced N events past the last snapshot, we       -- create a new snapshot.       v <- AR.getCurrentVersion a@@ -64,7 +69,7 @@   where s0 = TransactionState eventStore_ [ ]  -- | Get an aggregate ref by GUID.-getById :: forall a e . (Typeable a, Typeable e, Event e, Default a, Aggregate a, Eventable a e) => GUID a -> TransactionT e IO (AggregateRef a e)+getById :: forall a e . (Typeable a, Typeable e, Serialize e, Default a, Aggregate a, Eventable a e) => GUID a -> TransactionT e IO (AggregateRef a e) getById guid = TransactionT $ do   -- Check through list to see if we've given out a reference to the aggregate before.   aggregateRefs <- fmap aggregateRefsToCommit get@@ -84,7 +89,7 @@  -- 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, Event e, Default a, Aggregate a) => GUID a -> Transaction e IO (Int,a)+getLatestSnapshot :: forall a e . (Typeable a, Typeable e, Serialize e, Default a, Aggregate a) => GUID a -> Transaction e IO (Int,a) getLatestSnapshot guid = do   es <- fmap eventStore get   r <- liftIO $ ES.getLatestSnapshot es guid@@ -97,7 +102,7 @@       return (0, def)  -- Retrieve aggregate from event store.-getByIdFromEventStore :: forall a e . (Typeable a, Typeable e, Event e, Default a, Aggregate a, Eventable a e) => GUID a -> Transaction e IO (AggregateRef a e)+getByIdFromEventStore :: forall a e . (Typeable a, Typeable e, Serialize e, Default a, Aggregate a, Eventable a e) => GUID a -> Transaction e IO (AggregateRef a e) getByIdFromEventStore guid = do   es <- fmap eventStore get   -- Get latest snapshot (if any).@@ -105,7 +110,7 @@   -- Get events.   (latestVersion, events) <- lift $ ES.retrieveEvents es guid v0   -- Build the aggregate state from all the events.-  let a = foldr applyEvent a0 $ map (\e -> decodeEvent e :: e) events+  let a = foldr applyEvent a0 $ map (\e -> decode' e :: e) events   -- Make the aggregate itself   (a' :: AggregateRef a e) <- lift $ mkAggregateRef a guid latestVersion v0   -- Add to set of aggregates to commit later.@@ -114,7 +119,7 @@   return a'  -- | Publish event for an aggregate root.-publishEvent :: (MonadIO m, Event e, Eventable a e) => AggregateRef a e -> e -> TransactionT e m ()+publishEvent :: (MonadIO m, Serialize e, Eventable a e) => AggregateRef a e -> e -> TransactionT e m () publishEvent aggregateRef event = lift $ AR.publishEvent aggregateRef event  -- | Retrieve a range of events, invoking a callback function for each event.@@ -129,15 +134,15 @@ -- and "logical time" 30 (not inclusive). "Logical time" starts -- at 1. It is NOT an error to provide bounds for which there -- are no events.-retrieveEvents :: forall e . (Event e) => Int -> Int -> (e -> IO ()) -> TransactionT e IO ()+retrieveEvents :: forall e . (Serialize e) => Int -> Int -> (e -> IO ()) -> TransactionT e IO () retrieveEvents minVersion maxVersion h = TransactionT $ do   es <- fmap eventStore get   lift $ ES.readAllEvents es minVersion maxVersion $ \ed -> do-    let e :: e = decodeEvent ed+    let e :: e = decode' ed     liftIO $ h e  -- | Get aggregate root.-getAggregateRoot :: (Default a, Event e, Typeable a, Typeable e, Aggregate a, Eventable a e) => GUID a -> TransactionT e IO (AggregateRef a e, a)+getAggregateRoot :: (Default a, Serialize e, Typeable a, Typeable e, Aggregate a, Eventable a e) => GUID a -> TransactionT e IO (AggregateRef a e, a) getAggregateRoot guid = do   aggregateRef <- getById guid   aggregate <- lift $ AR.readValue aggregateRef