Default.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}

module Persistent.EventSource.EventStore.Default where

import qualified Database.Esqueleto.Monad.Experimental as Ex
import Database.Persist.Monad.Class
import Database.Persist.Monad
import Data.Dynamic
import Data.Time
import Control.Monad.IO.Class
import Control.Monad
import Database.Persist.Class(EntityField, PersistField, PersistEntity, PersistRecordBackend)
import Database.Persist.Class.PersistEntity(Entity(..), Key, SelectOpt(..))
import Database.Persist.Sql(SqlBackend)

defaultStoreMany :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => [record] -> m [Key record]
defaultStoreMany = insertMany

defaultGetLastAppliedEventId :: (PersistEntity record, Typeable record,
                             MonadSqlQuery m,
                             Ex.PersistEntityBackend record ~ SqlBackend) =>
                            EntityField record typ -> (record -> b) -> m (Maybe b)
defaultGetLastAppliedEventId sortField extractId = do
    lastEvent <- selectFirst [] [Desc sortField]
    pure $ (extractId . entityVal) <$> lastEvent

defaultMarkEventsApplied :: (MonadIO m, PersistEntity record,
                                   Typeable record,
                                    MonadSqlQuery m,
                                   Ex.PersistEntityBackend record ~ SqlBackend) =>
                                  (t -> Key record) -> (UTCTime -> t -> record) -> [t] -> m ()
defaultMarkEventsApplied toKey toRecord eventIds = do
    appliedEvents <- forM eventIds $ \eventId -> do
      time' <- liftIO getCurrentTime
      pure $ Entity (toKey eventId) $ toRecord time' eventId
    insertEntityMany appliedEvents


defaultLoadUnappliedEvents :: (Traversable t,
                    MonadSqlQuery m,
              PersistEntity val1, PersistEntity val2,
              PersistField a) =>
             EntityField val1 a -> EntityField val2 a -> t a -> m [Entity val1]
defaultLoadUnappliedEvents eventId appliedId mapplied = do
    Ex.select $ do
          event <- Ex.from $ Ex.table
          void $ forM mapplied $ \applied ->
            Ex.where_ $ event Ex.^. eventId Ex.>. Ex.val applied
          Ex.where_ $ Ex.notExists $ do
            applied <- Ex.from $ Ex.table
            Ex.where_ $ event Ex.^. eventId Ex.==. applied Ex.^. appliedId
          Ex.orderBy
            [ Ex.asc $ event Ex.^. eventId
            ]
          pure event