packages feed

eventful-memory 0.1.3 → 0.2.0

raw patch · 8 files changed

+181/−214 lines, 8 filesdep −hlintPVP ok

version bump matches the API change (PVP)

Dependencies removed: hlint

API changes (from Hackage documentation)

- Eventful.Store.Memory: embeddedStateEventStore :: (MonadState s m) => (s -> EventMap serialized) -> (s -> EventMap serialized -> s) -> EventStore serialized m
- Eventful.Store.Memory: embeddedStateGloballyOrderedEventStore :: (MonadState s m) => (s -> EventMap serialized) -> GloballyOrderedEventStore serialized m
- Eventful.Store.Memory: instance GHC.Show.Show serialized => GHC.Show.Show (Eventful.Store.Memory.EventMap serialized)
- Eventful.Store.Memory: stateEventStore :: (MonadState (EventMap serialized) m) => EventStore serialized m
- Eventful.Store.Memory: stateGloballyOrderedEventStore :: (MonadState (EventMap serialized) m) => GloballyOrderedEventStore serialized m
- Eventful.Store.Memory: tvarEventStore :: TVar (EventMap serialized) -> EventStore serialized STM
- Eventful.Store.Memory: tvarGloballyOrderedEventStore :: TVar (EventMap serialized) -> GloballyOrderedEventStore serialized STM
+ Eventful.Store.Memory: embeddedStateEventStoreReader :: (MonadState s m) => (s -> EventMap event) -> VersionedEventStoreReader m event
+ Eventful.Store.Memory: embeddedStateEventStoreWriter :: (MonadState s m) => (s -> EventMap event) -> (s -> EventMap event -> s) -> EventStoreWriter m event
+ Eventful.Store.Memory: embeddedStateGlobalEventStoreReader :: (MonadState s m) => (s -> EventMap event) -> GlobalEventStoreReader m event
+ Eventful.Store.Memory: instance GHC.Show.Show event => GHC.Show.Show (Eventful.Store.Memory.EventMap event)
+ Eventful.Store.Memory: stateEventStoreReader :: (MonadState (EventMap event) m) => VersionedEventStoreReader m event
+ Eventful.Store.Memory: stateEventStoreWriter :: (MonadState (EventMap event) m) => EventStoreWriter m event
+ Eventful.Store.Memory: stateGlobalEventStoreReader :: (MonadState (EventMap event) m) => GlobalEventStoreReader m event
+ Eventful.Store.Memory: tvarEventStoreReader :: TVar (EventMap event) -> VersionedEventStoreReader STM event
+ Eventful.Store.Memory: tvarEventStoreWriter :: TVar (EventMap event) -> EventStoreWriter STM event
+ Eventful.Store.Memory: tvarGlobalEventStoreReader :: TVar (EventMap event) -> GlobalEventStoreReader STM event
- Eventful.ProjectionCache.Memory: embeddedStateProjectionCache :: (MonadState s m, Ord key) => (s -> ProjectionMap key orderKey serialized) -> (s -> ProjectionMap key orderKey serialized -> s) -> ProjectionCache key orderKey serialized m
+ Eventful.ProjectionCache.Memory: embeddedStateProjectionCache :: (MonadState s m, Ord key) => (s -> ProjectionMap key position serialized) -> (s -> ProjectionMap key position serialized -> s) -> ProjectionCache key position serialized m
- Eventful.ProjectionCache.Memory: emptyProjectionMap :: ProjectionMap key orderKey serialized
+ Eventful.ProjectionCache.Memory: emptyProjectionMap :: ProjectionMap key position serialized
- Eventful.ProjectionCache.Memory: projectionMapTVar :: IO (TVar (ProjectionMap key orderKey serialized))
+ Eventful.ProjectionCache.Memory: projectionMapTVar :: IO (TVar (ProjectionMap key position serialized))
- Eventful.ProjectionCache.Memory: tvarProjectionCache :: (Ord key) => TVar (ProjectionMap key orderKey serialized) -> ProjectionCache key orderKey serialized STM
+ Eventful.ProjectionCache.Memory: tvarProjectionCache :: (Ord key) => TVar (ProjectionMap key position serialized) -> ProjectionCache key position serialized STM
- Eventful.ProjectionCache.Memory: type ProjectionMap key orderKey serialized = Map key (orderKey, serialized)
+ Eventful.ProjectionCache.Memory: type ProjectionMap key position serialized = Map key (position, serialized)
- Eventful.ReadModel.Memory: memoryReadModel :: (MonadIO m) => modeldata -> (modeldata -> [GloballyOrderedEvent serialized] -> m modeldata) -> IO (ReadModel (TVar (MemoryReadModelData modeldata)) serialized m)
+ Eventful.ReadModel.Memory: memoryReadModel :: (MonadIO m) => modeldata -> (modeldata -> [GlobalStreamEvent serialized] -> m modeldata) -> IO (ReadModel (TVar (MemoryReadModelData modeldata)) serialized m)
- Eventful.Store.Memory: data EventMap serialized
+ Eventful.Store.Memory: data EventMap event
- Eventful.Store.Memory: emptyEventMap :: EventMap serialized
+ Eventful.Store.Memory: emptyEventMap :: EventMap event
- Eventful.Store.Memory: eventMapTVar :: IO (TVar (EventMap serialized))
+ Eventful.Store.Memory: eventMapTVar :: IO (TVar (EventMap event))

Files

eventful-memory.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           eventful-memory-version:        0.1.3+version:        0.2.0 synopsis:       In-memory implementations for eventful description:    In-memory implementations for eventful category:       Database,Eventsourcing@@ -61,30 +61,8 @@   other-modules:       Eventful.ProjectionCache.MemorySpec       Eventful.Store.MemorySpec-      HLint       MemoryTestImport       Eventful.ProjectionCache.Memory       Eventful.ReadModel.Memory       Eventful.Store.Memory-  default-language: Haskell2010--test-suite style-  type: exitcode-stdio-1.0-  main-is: HLint.hs-  hs-source-dirs:-      tests-  ghc-options: -Wall-  build-depends:-      base >= 4.9 && < 5-    , eventful-core-    , containers-    , mtl-    , safe-    , stm-    , hlint-  other-modules:-      Eventful.ProjectionCache.MemorySpec-      Eventful.Store.MemorySpec-      MemoryTestImport-      Spec   default-language: Haskell2010
src/Eventful/ProjectionCache/Memory.hs view
@@ -18,28 +18,28 @@ import Eventful.ProjectionCache.Types  -- | A 'ProjectionMap' just stores the latest snapshot for each UUID.-type ProjectionMap key orderKey serialized = Map key (orderKey, serialized)+type ProjectionMap key position serialized = Map key (position, serialized) -emptyProjectionMap :: ProjectionMap key orderKey serialized+emptyProjectionMap :: ProjectionMap key position serialized emptyProjectionMap = Map.empty -projectionMapTVar :: IO (TVar (ProjectionMap key orderKey serialized))+projectionMapTVar :: IO (TVar (ProjectionMap key position serialized)) projectionMapTVar = newTVarIO emptyProjectionMap  storeProjectionInMap   :: (Ord key)   => key-  -> orderKey+  -> position   -> serialized-  -> ProjectionMap key orderKey serialized-  -> ProjectionMap key orderKey serialized+  -> ProjectionMap key position serialized+  -> ProjectionMap key position serialized storeProjectionInMap uuid version state = Map.insert uuid (version, state)  -- | A 'ProjectionCache' that uses a 'TVar' and runs in 'STM'. tvarProjectionCache   :: (Ord key)-  => TVar (ProjectionMap key orderKey serialized)-  -> ProjectionCache key orderKey serialized STM+  => TVar (ProjectionMap key position serialized)+  -> ProjectionCache key position serialized STM tvarProjectionCache tvar =   let     storeProjectionSnapshot uuid version projState = modifyTVar' tvar (storeProjectionInMap uuid version projState)@@ -49,9 +49,9 @@ -- | A 'ProjectionCache' for some 'MonadState' that contains a 'ProjectionMap'. embeddedStateProjectionCache   :: (MonadState s m, Ord key)-  => (s -> ProjectionMap key orderKey serialized)-  -> (s -> ProjectionMap key orderKey serialized -> s)-  -> ProjectionCache key orderKey serialized m+  => (s -> ProjectionMap key position serialized)+  -> (s -> ProjectionMap key position serialized -> s)+  -> ProjectionCache key position serialized m embeddedStateProjectionCache getMap setMap =   let     storeProjectionSnapshot uuid version projState = modify' (storeProjectionSnapshot' uuid version projState)
src/Eventful/ReadModel/Memory.hs view
@@ -20,7 +20,7 @@ memoryReadModel   :: (MonadIO m)   => modeldata-  -> (modeldata -> [GloballyOrderedEvent serialized] -> m modeldata)+  -> (modeldata -> [GlobalStreamEvent serialized] -> m modeldata)   -> IO (ReadModel (TVar (MemoryReadModelData modeldata)) serialized m) memoryReadModel initialValue handleEvents = do   tvar <- newTVarIO $ MemoryReadModelData (-1) initialValue@@ -29,6 +29,6 @@     getLatestSequence tvar' = liftIO $ memoryReadModelDataLatestSequenceNumber <$> readTVarIO tvar'     handleTVarEvents tvar' events = do       (MemoryReadModelData latestSeq modelData) <- liftIO $ readTVarIO tvar'-      let latestSeq' = maximumDef latestSeq (globallyOrderedEventSequenceNumber <$> events)+      let latestSeq' = maximumDef latestSeq (streamEventPosition <$> events)       modelData' <- handleEvents modelData events       liftIO . atomically . writeTVar tvar' $ MemoryReadModelData latestSeq' modelData'
src/Eventful/Store/Memory.hs view
@@ -1,13 +1,15 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RecordWildCards #-}  module Eventful.Store.Memory-  ( tvarEventStore-  , tvarGloballyOrderedEventStore-  , stateEventStore-  , stateGloballyOrderedEventStore-  , embeddedStateEventStore-  , embeddedStateGloballyOrderedEventStore+  ( tvarEventStoreReader+  , tvarEventStoreWriter+  , tvarGlobalEventStoreReader+  , stateEventStoreReader+  , stateEventStoreWriter+  , stateGlobalEventStoreReader+  , embeddedStateEventStoreReader+  , embeddedStateEventStoreWriter+  , embeddedStateGlobalEventStoreReader   , EventMap   , emptyEventMap   , eventMapTVar@@ -17,7 +19,6 @@ import Control.Concurrent.STM import Control.Monad.State.Class import Data.Foldable (toList)-import Data.List (sortOn) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe)@@ -28,128 +29,132 @@ import Eventful.UUID  -- | Internal data structure used for the in-memory event stores.-data EventMap serialized+data EventMap event   = EventMap-  { _eventMapUuidMap :: Map UUID (Seq (GloballyOrderedEvent serialized))-  , _eventMapSeqNum :: SequenceNumber-  -- TODO: Add projection cache here+  { _eventMapUuidMap :: Map UUID (Seq (VersionedStreamEvent event))+  , _eventMapGlobalEvents :: Seq (VersionedStreamEvent event)   }   deriving (Show)  -- | What it says on the tin, an initialized empty 'EventMap'-emptyEventMap :: EventMap serialized-emptyEventMap = EventMap Map.empty 0+emptyEventMap :: EventMap event+emptyEventMap = EventMap Map.empty Seq.empty  -- | Initialize an 'EventMap' in a 'TVar'-eventMapTVar :: IO (TVar (EventMap serialized))+eventMapTVar :: IO (TVar (EventMap event)) eventMapTVar = newTVarIO emptyEventMap --- | An 'EventStore' that stores events in a 'TVar' and runs in 'STM'. This--- functions initializes the store by creating the 'TVar' and hooking up the--- event store API to that 'TVar'.-tvarEventStore :: TVar (EventMap serialized) -> EventStore serialized STM-tvarEventStore tvar =-  let+-- | An 'EventStoreReader' that stores events in a 'TVar' and runs in 'STM'.+-- This functions initializes the store by creating the 'TVar' and hooking up+-- the event store API to that 'TVar'.+tvarEventStoreReader :: TVar (EventMap event) -> VersionedEventStoreReader STM event+tvarEventStoreReader tvar = EventStoreReader $ \range -> lookupEventsInRange range <$> readTVar tvar++tvarEventStoreWriter :: TVar (EventMap event) -> EventStoreWriter STM event+tvarEventStoreWriter tvar = EventStoreWriter $ transactionalExpectedWriteHelper getLatestVersion storeEvents'+  where     getLatestVersion uuid = flip latestEventVersion uuid <$> readTVar tvar-    getEvents uuid range = (\s -> lookupEventsInRange s uuid range) <$> readTVar tvar     storeEvents' uuid events = modifyTVar' tvar (\store -> storeEventMap store uuid events)-    storeEvents = transactionalExpectedWriteHelper getLatestVersion storeEvents'-  in EventStore{..} --- | Analog of 'tvarEventStore' for a 'GloballyOrderedEventStore'-tvarGloballyOrderedEventStore :: TVar (EventMap serialized) -> GloballyOrderedEventStore serialized STM-tvarGloballyOrderedEventStore tvar =-  let-    getSequencedEvents range = flip lookupEventMapRange range <$> readTVar tvar-  in GloballyOrderedEventStore{..}+-- | Analog of 'tvarEventStoreReader' for a 'GlobalEventStoreReader'+tvarGlobalEventStoreReader :: TVar (EventMap event) ->  GlobalEventStoreReader STM event+tvarGlobalEventStoreReader tvar = EventStoreReader $ \range -> lookupGlobalEvents range <$> readTVar tvar --- | Specialized version of 'embeddedStateEventStore' that only contains an+-- | Specialized version of 'embeddedStateEventStoreReader' that only contains an -- 'EventMap' in the state.-stateEventStore-  :: (MonadState (EventMap serialized) m)-  => EventStore serialized m-stateEventStore = embeddedStateEventStore id (flip const)+stateEventStoreReader+  :: (MonadState (EventMap event) m)+  => VersionedEventStoreReader m event+stateEventStoreReader = embeddedStateEventStoreReader id +stateGlobalEventStoreReader+  :: (MonadState (EventMap event) m)+  => GlobalEventStoreReader m event+stateGlobalEventStoreReader = embeddedStateGlobalEventStoreReader id++-- | Specialized version of 'embeddedStateEventStoreWriter' that only contains an+-- 'EventMap' in the state.+stateEventStoreWriter+  :: (MonadState (EventMap event) m)+  => EventStoreWriter m event+stateEventStoreWriter = embeddedStateEventStoreWriter id (flip const)+ -- | An 'EventStore' that runs on some 'MonadState' that contains an -- 'EventMap'. This is useful if you want to include other state in your -- 'MonadState'.-embeddedStateEventStore+embeddedStateEventStoreReader   :: (MonadState s m)-  => (s -> EventMap serialized)-  -> (s -> EventMap serialized -> s)-  -> EventStore serialized m-embeddedStateEventStore getMap setMap =-  let+  => (s -> EventMap event)+  -> VersionedEventStoreReader m event+embeddedStateEventStoreReader getMap = EventStoreReader $ \range -> lookupEventsInRange range <$> gets getMap++embeddedStateEventStoreWriter+  :: (MonadState s m)+  => (s -> EventMap event)+  -> (s -> EventMap event -> s)+  -> EventStoreWriter m event+embeddedStateEventStoreWriter getMap setMap = EventStoreWriter $ transactionalExpectedWriteHelper getLatestVersion storeEvents'+  where     getLatestVersion uuid = flip latestEventVersion uuid <$> gets getMap-    getEvents uuid range = (\s -> lookupEventsInRange s uuid range) <$> gets getMap     storeEvents' uuid events = modify' (modifyStore uuid events)-    storeEvents = transactionalExpectedWriteHelper getLatestVersion storeEvents'-  in EventStore{..}-  where     modifyStore uuid events state' =       let         store = getMap state'         store' = storeEventMap store uuid events       in setMap state' store' --- | Analogous to 'stateEventStore' for a 'GloballyOrderedEventStore'.-stateGloballyOrderedEventStore-  :: (MonadState (EventMap serialized) m)-  => GloballyOrderedEventStore serialized m-stateGloballyOrderedEventStore = embeddedStateGloballyOrderedEventStore id---- | Analogous to 'embeddedStateEventStore' for a 'GloballyOrderedEventStore'.-embeddedStateGloballyOrderedEventStore+-- | Analogous to 'embeddedStateEventStore' for a 'GlobalStreamEventStore'.+embeddedStateGlobalEventStoreReader   :: (MonadState s m)-  => (s -> EventMap serialized)-  -> GloballyOrderedEventStore serialized m-embeddedStateGloballyOrderedEventStore getMap =-  let-    getSequencedEvents range = flip lookupEventMapRange range <$> gets getMap-  in GloballyOrderedEventStore{..}+  => (s -> EventMap event)+  -> GlobalEventStoreReader m event+embeddedStateGlobalEventStoreReader getMap = EventStoreReader $ \range -> lookupGlobalEvents range <$> gets getMap -lookupEventMapRaw :: EventMap serialized -> UUID -> Seq (StoredEvent serialized)-lookupEventMapRaw (EventMap uuidMap _) uuid =-  fmap globallyOrderedEventToStoredEvent $ fromMaybe Seq.empty $ Map.lookup uuid uuidMap+lookupEventMapRaw :: EventMap event -> UUID -> Seq (VersionedStreamEvent event)+lookupEventMapRaw (EventMap uuidMap _) uuid = fromMaybe Seq.empty $ Map.lookup uuid uuidMap -lookupEventsInRange :: EventMap serialized -> UUID -> EventStoreQueryRange EventVersion -> [StoredEvent serialized]-lookupEventsInRange store uuid range = filterEventsByRange range' 0 rawEvents+lookupEventsInRange :: QueryRange UUID EventVersion -> EventMap event -> [VersionedStreamEvent event]+lookupEventsInRange (QueryRange uuid start limit) store = toList $ filterEventsByRange start' limit' 0 rawEvents   where-    range' = unEventVersion <$> range-    rawEvents = toList $ lookupEventMapRaw store uuid+    start' = unEventVersion <$> start+    limit' = unEventVersion <$> limit+    rawEvents = lookupEventMapRaw store uuid -filterEventsByRange :: EventStoreQueryRange Int -> Int -> [event] -> [event]-filterEventsByRange EventStoreQueryRange{..} defaultStart events =+filterEventsByRange :: QueryStart Int -> QueryLimit Int -> Int -> Seq event -> Seq event+filterEventsByRange queryStart queryLimit defaultStart events =   let     (start', events') =-      case eventStoreQueryRangeStart of+      case queryStart of         StartFromBeginning -> (defaultStart, events)-        StartQueryAt start -> (start, drop (start - defaultStart) events)+        StartQueryAt start -> (start, Seq.drop (start - defaultStart) events)     events'' =-      case eventStoreQueryRangeLimit of+      case queryLimit of         NoQueryLimit -> events'-        MaxNumberOfEvents num -> take num events'-        StopQueryAt stop -> take (stop - start' + 1) events'+        MaxNumberOfEvents num -> Seq.take num events'+        StopQueryAt stop -> Seq.take (stop - start' + 1) events'   in events'' -latestEventVersion :: EventMap serialized -> UUID -> EventVersion+latestEventVersion :: EventMap event -> UUID -> EventVersion latestEventVersion store uuid = EventVersion $ Seq.length (lookupEventMapRaw store uuid) - 1 -lookupEventMapRange :: EventMap serialized -> EventStoreQueryRange SequenceNumber -> [GloballyOrderedEvent serialized]-lookupEventMapRange (EventMap uuidMap _) range = filterEventsByRange range' 1 rawEvents+lookupGlobalEvents :: QueryRange () SequenceNumber -> EventMap event -> [GlobalStreamEvent event]+lookupGlobalEvents (QueryRange () start limit) (EventMap _ globalEvents) = events'   where-    range' = unSequenceNumber <$> range-    rawEvents =-      sortOn globallyOrderedEventSequenceNumber $-      concat $-      toList <$> toList uuidMap+    start' = unSequenceNumber <$> start+    limit' = unSequenceNumber <$> limit+    events = toList $ filterEventsByRange start' limit' 1 globalEvents+    events' = zipWith (StreamEvent ()) [startingSeqNum..] events+    startingSeqNum =+      case start of+        StartFromBeginning -> 1+        (StartQueryAt startSeq) -> startSeq  storeEventMap-  :: EventMap serialized -> UUID -> [serialized] -> EventMap serialized-storeEventMap store@(EventMap uuidMap seqNum) uuid events =+  :: EventMap event -> UUID -> [event] -> EventMap event+storeEventMap store@(EventMap uuidMap globalEvents) uuid events =   let     versStart = latestEventVersion store uuid + 1-    storedEvents = zipWith storedEventToGloballyOrderedEvent [seqNum + 1..] $ zipWith (StoredEvent uuid) [versStart..] events-    newMap = Map.insertWith (flip (><)) uuid (Seq.fromList storedEvents) uuidMap-    newSeq = seqNum + (SequenceNumber $ length events)-  in EventMap newMap newSeq+    streamEvents = zipWith (StreamEvent uuid) [versStart..] events+    newMap = Map.insertWith (flip (><)) uuid (Seq.fromList streamEvents) uuidMap+    globalEvents' = globalEvents >< Seq.fromList streamEvents+  in EventMap newMap globalEvents'
tests/Eventful/ProjectionCache/MemorySpec.hs view
@@ -13,42 +13,44 @@ spec :: Spec spec = do   describe "TVar projection cache" $ do-    streamProjectionCacheSpec tvarStreamProjectionCacheRunner-    globallyOrderedProjectionCacheSpec tvarGloballyOrderedProjectionCacheRunner+    versionedProjectionCacheSpec tvarVersionedProjectionCacheRunner+    globalStreamProjectionCacheSpec tvarGlobalStreamProjectionCacheRunner    describe "MonadState embedded memory projection cache" $ do-    streamProjectionCacheSpec stateStreamProjectionCacheRunner-    globallyOrderedProjectionCacheSpec stateGloballyOrderedProjectionCacheRunner+    versionedProjectionCacheSpec stateVersionedProjectionCacheRunner+    globalStreamProjectionCacheSpec stateGlobalStreamProjectionCacheRunner -tvarStreamProjectionCacheRunner :: StreamProjectionCacheRunner STM-tvarStreamProjectionCacheRunner = StreamProjectionCacheRunner $ \action -> do+tvarVersionedProjectionCacheRunner :: VersionedProjectionCacheRunner STM+tvarVersionedProjectionCacheRunner = VersionedProjectionCacheRunner $ \action -> do   eventTVar <- eventMapTVar   projTVar <- projectionMapTVar   let-    store = tvarEventStore eventTVar+    writer = tvarEventStoreWriter eventTVar+    reader = tvarEventStoreReader eventTVar     cache = tvarProjectionCache projTVar-  atomically $ action store cache+  atomically $ action writer reader cache -tvarGloballyOrderedProjectionCacheRunner :: GloballyOrderedProjectionCacheRunner STM-tvarGloballyOrderedProjectionCacheRunner = GloballyOrderedProjectionCacheRunner $ \action -> do+tvarGlobalStreamProjectionCacheRunner :: GlobalStreamProjectionCacheRunner STM+tvarGlobalStreamProjectionCacheRunner = GlobalStreamProjectionCacheRunner $ \action -> do   eventTVar <- eventMapTVar   projTVar <- projectionMapTVar   let-    store = tvarEventStore eventTVar-    globalStore = tvarGloballyOrderedEventStore eventTVar+    writer = tvarEventStoreWriter eventTVar+    globalReader = tvarGlobalEventStoreReader eventTVar     cache = tvarProjectionCache projTVar-  atomically $ action store globalStore cache+  atomically $ action writer globalReader cache -stateStreamProjectionCacheRunner :: StreamProjectionCacheRunner (StateT (StreamEmbeddedState Counter CounterEvent) IO)-stateStreamProjectionCacheRunner = StreamProjectionCacheRunner $ \action -> evalStateT (action store cache) emptyEmbeddedState+stateVersionedProjectionCacheRunner :: VersionedProjectionCacheRunner (StateT (StreamEmbeddedState Counter CounterEvent) IO)+stateVersionedProjectionCacheRunner = VersionedProjectionCacheRunner $ \action -> evalStateT (action writer reader cache) emptyEmbeddedState   where-    store = embeddedStateEventStore embeddedEventMap setEventMap+    writer = embeddedStateEventStoreWriter embeddedEventMap setEventMap+    reader = embeddedStateEventStoreReader embeddedEventMap     cache = embeddedStateProjectionCache embeddedProjectionMap setProjectionMap -stateGloballyOrderedProjectionCacheRunner :: GloballyOrderedProjectionCacheRunner (StateT (GloballyOrderedEmbeddedState Counter CounterEvent Text) IO)-stateGloballyOrderedProjectionCacheRunner =-  GloballyOrderedProjectionCacheRunner $ \action -> evalStateT (action store globalStore cache) emptyEmbeddedState+stateGlobalStreamProjectionCacheRunner :: GlobalStreamProjectionCacheRunner (StateT (GlobalStreamEmbeddedState Counter CounterEvent Text) IO)+stateGlobalStreamProjectionCacheRunner =+  GlobalStreamProjectionCacheRunner $ \action -> evalStateT (action writer globalReader cache) emptyEmbeddedState   where-    store = embeddedStateEventStore embeddedEventMap setEventMap-    globalStore = embeddedStateGloballyOrderedEventStore embeddedEventMap+    writer = embeddedStateEventStoreWriter embeddedEventMap setEventMap+    globalReader = embeddedStateGlobalEventStoreReader embeddedEventMap     cache = embeddedStateProjectionCache embeddedProjectionMap setProjectionMap
tests/Eventful/Store/MemorySpec.hs view
@@ -4,6 +4,7 @@ import Control.Monad.State.Strict import Test.Hspec +import Eventful.Serializer import Eventful.Store.Memory import Eventful.TestHelpers @@ -13,52 +14,68 @@ spec = do   describe "TVar memory event store with actual event type" $ do     eventStoreSpec tvarRunner-    sequencedEventStoreSpec tvarGlobalRunner+    globalStreamEventStoreSpec tvarGlobalRunner    describe "TVar memory event store with Dynamic serialized type" $ do     eventStoreSpec tvarDynamicRunner-    sequencedEventStoreSpec tvarDynamicGlobalRunner+    globalStreamEventStoreSpec tvarDynamicGlobalRunner    describe "MonadState memory event store with actual event type" $ do     eventStoreSpec stateStoreRunner-    sequencedEventStoreSpec stateStoreGlobalRunner+    globalStreamEventStoreSpec stateStoreGlobalRunner    describe "MonadState embedded memory event store with actual event type" $ do     eventStoreSpec embeddedStateStoreRunner-    sequencedEventStoreSpec embeddedStateStoreGlobalRunner+    globalStreamEventStoreSpec embeddedStateStoreGlobalRunner  tvarRunner :: EventStoreRunner STM-tvarRunner = EventStoreRunner $ \action -> (tvarEventStore <$> eventMapTVar) >>= atomically . action+tvarRunner = EventStoreRunner $ \action -> do+  eventTVar <- eventMapTVar+  let+    writer = tvarEventStoreWriter eventTVar+    reader = tvarEventStoreReader eventTVar+  atomically $ action writer reader -tvarGlobalRunner :: GloballyOrderedEventStoreRunner STM-tvarGlobalRunner = GloballyOrderedEventStoreRunner $ \action -> do-  tvar <- eventMapTVar+tvarGlobalRunner :: GlobalStreamEventStoreRunner STM+tvarGlobalRunner = GlobalStreamEventStoreRunner $ \action -> do+  eventTVar <- eventMapTVar   let-    store = tvarEventStore tvar-    globalStore = tvarGloballyOrderedEventStore tvar-  atomically $ action store globalStore+    writer = tvarEventStoreWriter eventTVar+    globalReader = tvarGlobalEventStoreReader eventTVar+  atomically $ action writer globalReader  tvarDynamicRunner :: EventStoreRunner STM-tvarDynamicRunner = EventStoreRunner $ \action -> (fst <$> makeDynamicTVarStore) >>= atomically . action+tvarDynamicRunner = EventStoreRunner $ \action -> do+  eventTVar <- eventMapTVar+  let+    writer = serializedEventStoreWriter dynamicSerializer $ tvarEventStoreWriter eventTVar+    reader = serializedVersionedEventStoreReader dynamicSerializer $ tvarEventStoreReader eventTVar+  atomically $ action writer reader -tvarDynamicGlobalRunner :: GloballyOrderedEventStoreRunner STM-tvarDynamicGlobalRunner = GloballyOrderedEventStoreRunner $ \action -> makeDynamicTVarStore >>= atomically . uncurry action+tvarDynamicGlobalRunner :: GlobalStreamEventStoreRunner STM+tvarDynamicGlobalRunner = GlobalStreamEventStoreRunner $ \action -> do+  eventTVar <- eventMapTVar+  let+    writer = serializedEventStoreWriter dynamicSerializer $ tvarEventStoreWriter eventTVar+    globalReader = serializedGlobalEventStoreReader dynamicSerializer $ tvarGlobalEventStoreReader eventTVar+  atomically $ action writer globalReader  stateStoreRunner :: EventStoreRunner (StateT (EventMap CounterEvent) IO)-stateStoreRunner = EventStoreRunner $ \action -> evalStateT (action stateEventStore) emptyEventMap+stateStoreRunner = EventStoreRunner $ \action -> evalStateT (action stateEventStoreWriter stateEventStoreReader) emptyEventMap -stateStoreGlobalRunner :: GloballyOrderedEventStoreRunner (StateT (EventMap CounterEvent) IO)-stateStoreGlobalRunner = GloballyOrderedEventStoreRunner $-  \action -> evalStateT (action stateEventStore stateGloballyOrderedEventStore) emptyEventMap+stateStoreGlobalRunner :: GlobalStreamEventStoreRunner (StateT (EventMap CounterEvent) IO)+stateStoreGlobalRunner = GlobalStreamEventStoreRunner $+  \action -> evalStateT (action stateEventStoreWriter stateGlobalEventStoreReader) emptyEventMap  embeddedStateStoreRunner :: EventStoreRunner (StateT (StreamEmbeddedState Counter CounterEvent) IO)-embeddedStateStoreRunner = EventStoreRunner $ \action -> evalStateT (action store) emptyEmbeddedState+embeddedStateStoreRunner = EventStoreRunner $ \action -> evalStateT (action writer reader) emptyEmbeddedState   where-    store = embeddedStateEventStore embeddedEventMap setEventMap+    writer = embeddedStateEventStoreWriter embeddedEventMap setEventMap+    reader = embeddedStateEventStoreReader embeddedEventMap -embeddedStateStoreGlobalRunner :: GloballyOrderedEventStoreRunner (StateT (StreamEmbeddedState Counter CounterEvent) IO)-embeddedStateStoreGlobalRunner = GloballyOrderedEventStoreRunner $-  \action -> evalStateT (action store globalStore) emptyEmbeddedState+embeddedStateStoreGlobalRunner :: GlobalStreamEventStoreRunner (StateT (StreamEmbeddedState Counter CounterEvent) IO)+embeddedStateStoreGlobalRunner = GlobalStreamEventStoreRunner $+  \action -> evalStateT (action writer globalReader) emptyEmbeddedState   where-    store = embeddedStateEventStore embeddedEventMap setEventMap-    globalStore = embeddedStateGloballyOrderedEventStore embeddedEventMap+    writer = embeddedStateEventStoreWriter embeddedEventMap setEventMap+    globalReader = embeddedStateGlobalEventStoreReader embeddedEventMap
− tests/HLint.hs
@@ -1,20 +0,0 @@-module Main (main) where--import Language.Haskell.HLint (hlint)-import System.Exit (exitFailure, exitSuccess)--import Prelude (String, IO, null)--arguments :: [String]-arguments =-    [ "src"-    , "tests"-    , "-i=Redundant do"-    , "-i=Unused LANGUAGE pragma" -- This fails on DeriveGeneric-    , "-i=Use section"-    ]--main :: IO ()-main = do-    hints <- hlint arguments-    if null hints then exitSuccess else exitFailure
tests/MemoryTestImport.hs view
@@ -1,49 +1,34 @@ module MemoryTestImport-  ( makeDynamicTVarStore-  , EmbeddedState (..)+  ( EmbeddedState (..)   , StreamEmbeddedState-  , GloballyOrderedEmbeddedState+  , GlobalStreamEmbeddedState   , emptyEmbeddedState   , setEventMap   , setProjectionMap   ) where -import Control.Concurrent.STM- import Eventful.ProjectionCache.Memory-import Eventful.Serializer import Eventful.Store.Memory-import Eventful.TestHelpers import Eventful.UUID -makeDynamicTVarStore :: IO (EventStore CounterEvent STM, GloballyOrderedEventStore CounterEvent STM)-makeDynamicTVarStore = do-  tvar <- eventMapTVar-  let-    store = tvarEventStore tvar-    globalStore = tvarGloballyOrderedEventStore tvar-    store' = serializedEventStore dynamicSerializer store-    globalStore' = serializedGloballyOrderedEventStore dynamicSerializer globalStore-  return (store', globalStore')--data EmbeddedState state event key orderKey+data EmbeddedState state event key position   = EmbeddedState   { _embeddedDummyArgument :: Int   , embeddedEventMap :: EventMap event-  , embeddedProjectionMap :: ProjectionMap key orderKey state+  , embeddedProjectionMap :: ProjectionMap key position state   }  type StreamEmbeddedState state event = EmbeddedState state event UUID EventVersion-type GloballyOrderedEmbeddedState state event key = EmbeddedState state event key SequenceNumber+type GlobalStreamEmbeddedState state event key = EmbeddedState state event key SequenceNumber -emptyEmbeddedState :: EmbeddedState state event key orderKey+emptyEmbeddedState :: EmbeddedState state event key position emptyEmbeddedState = EmbeddedState 100 emptyEventMap emptyProjectionMap -setEventMap :: EmbeddedState state event key orderKey -> EventMap event -> EmbeddedState state event key orderKey+setEventMap :: EmbeddedState state event key position -> EventMap event -> EmbeddedState state event key position setEventMap state' eventMap = state' { embeddedEventMap = eventMap }  setProjectionMap-  :: EmbeddedState state event key orderKey-  -> ProjectionMap key orderKey state-  -> EmbeddedState state event key orderKey+  :: EmbeddedState state event key position+  -> ProjectionMap key position state+  -> EmbeddedState state event key position setProjectionMap state' projectionMap = state' { embeddedProjectionMap = projectionMap }