import Control.Concurrent (forkIO, threadDelay) import Control.Monad.Trans.Class (lift) import Data.CQRS import Data.CQRS.EventStore.Backend.Sqlite3 import Data.IORef (newIORef, readIORef) import Aggregates import Events import Instances () import Query sqliteFile :: String sqliteFile = "example.db" eventSourcingThread :: EventStore Event -> IO () eventSourcingThread eventStore = do qsRef <- newIORef emptyQueryState loop qsRef where loop qsRef = do putStrLn "Sourcing events..." updateQueryStateRef qsRef eventStore qs <- readIORef qsRef putStrLn $ " => qs: " ++ show qs -- Wait 1 second threadDelay 1000000 -- Go again. loop qsRef test1 :: IO () test1 = do -- Start sourcing events. _ <- forkIO $ do withEventStore (openSqliteEventStore sqliteFile) eventSourcingThread -- Do a few things withEventStore (openSqliteEventStore sqliteFile) $ \eventStore -> do runTransactionT eventStore $ do -- Create new project. projectId :: GUID Project <- lift $ newGUID (projectRef, _) <- getAggregateRoot projectId publishEvent projectRef $ ProjectCreated "my project" -- Add a couple of tasks taskId1 :: GUID Task <- lift $ newGUID (taskRef1, _) <- getAggregateRoot taskId1 publishEvent taskRef1 $ TaskAdded projectId "tweak knob" taskId2 :: GUID Task <- lift $ newGUID (taskRef2, _) <- getAggregateRoot taskId2 publishEvent taskRef2 $ TaskAdded projectId "pull lever" -- Rename project. publishEvent projectRef $ ProjectRenamed "old project" main :: IO () main = do putStrLn "Running test1..." test1 putStrLn "Press to quit" _ <- getLine return ()