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 +1/−23
- src/Eventful/ProjectionCache/Memory.hs +11/−11
- src/Eventful/ReadModel/Memory.hs +2/−2
- src/Eventful/Store/Memory.hs +92/−87
- tests/Eventful/ProjectionCache/MemorySpec.hs +23/−21
- tests/Eventful/Store/MemorySpec.hs +42/−25
- tests/HLint.hs +0/−20
- tests/MemoryTestImport.hs +10/−25
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 }