cqrs-example-0.5.0: src/Query.hs

module Query ( emptyQueryState
             , updateQueryStateRef
             , QueryState
             ) where

import           Control.Monad (forM_)
import           Data.ByteString (ByteString)
import           Data.CQRS (enumerateEventStore, GUID, EventStore)
import           Data.Enumerator (run_, (>>==))
import qualified Data.Enumerator.List as EL
import           Data.IORef (IORef, readIORef, atomicModifyIORef)
import           Data.Map (Map)
import qualified Data.Map as M
import           Data.Serialize (encode)
import           Data.Text (Text)
import           Events (Event(..))

-- Update query state with latest events.
updateQueryStateRef :: IORef QueryState -> EventStore Event -> IO ()
updateQueryStateRef queryStateRef eventStore = do
  lastVersion <- fmap ((+) 1 . qsLastVersion) $ readIORef queryStateRef
  evs <- run_ (EL.consume >>== enumerateEventStore eventStore lastVersion)
  forM_ evs $ \(gv,(g,v,e)) -> do
    putStrLn $ show $ "ev(" ++ show gv ++ "): " ++ show e
    atomicModifyIORef queryStateRef $ \s -> (updateState s gv g v e, ())
  return ()

-- Update state per event.
updateState :: QueryState -> Int -> GUID a -> Int -> Event -> QueryState
updateState queryState gv guid _ (ProjectCreated pn) =
  queryState { qsLastVersion = gv
             , qsProjectNamesById = M.insert (encode guid) pn $ qsProjectNamesById queryState
             }
updateState queryState gv guid v (ProjectRenamed pn) =
  updateState queryState gv guid v (ProjectCreated pn)
updateState queryState gv _ _ (TaskAdded _ _) =
  queryState { qsLastVersion = gv }

-- In-memory data structure for querying. We should really use
-- a persistent store for this, but this is just an example.
data QueryState = QueryState { qsLastVersion :: Int
                             , qsProjectNamesById :: Map ByteString Text
                             }
                  deriving (Show)

-- Create "empty" data structure for querying.
emptyQueryState :: QueryState
emptyQueryState = QueryState 0 M.empty