diff --git a/eventful-memory.cabal b/eventful-memory.cabal --- a/eventful-memory.cabal +++ b/eventful-memory.cabal @@ -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 diff --git a/src/Eventful/ProjectionCache/Memory.hs b/src/Eventful/ProjectionCache/Memory.hs --- a/src/Eventful/ProjectionCache/Memory.hs +++ b/src/Eventful/ProjectionCache/Memory.hs @@ -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) diff --git a/src/Eventful/ReadModel/Memory.hs b/src/Eventful/ReadModel/Memory.hs --- a/src/Eventful/ReadModel/Memory.hs +++ b/src/Eventful/ReadModel/Memory.hs @@ -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' diff --git a/src/Eventful/Store/Memory.hs b/src/Eventful/Store/Memory.hs --- a/src/Eventful/Store/Memory.hs +++ b/src/Eventful/Store/Memory.hs @@ -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' diff --git a/tests/Eventful/ProjectionCache/MemorySpec.hs b/tests/Eventful/ProjectionCache/MemorySpec.hs --- a/tests/Eventful/ProjectionCache/MemorySpec.hs +++ b/tests/Eventful/ProjectionCache/MemorySpec.hs @@ -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 diff --git a/tests/Eventful/Store/MemorySpec.hs b/tests/Eventful/Store/MemorySpec.hs --- a/tests/Eventful/Store/MemorySpec.hs +++ b/tests/Eventful/Store/MemorySpec.hs @@ -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 diff --git a/tests/HLint.hs b/tests/HLint.hs deleted file mode 100644 --- a/tests/HLint.hs +++ /dev/null @@ -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 diff --git a/tests/MemoryTestImport.hs b/tests/MemoryTestImport.hs --- a/tests/MemoryTestImport.hs +++ b/tests/MemoryTestImport.hs @@ -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 }