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

module Persistent.Event.Source.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 :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[record] -> m [Key record]
defaultStoreMany = [record] -> m [Key record]
forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[record] -> m [Key record]
insertMany

defaultGetLastAppliedEventId :: (PersistEntity record, Typeable record,
                             MonadSqlQuery m,
                             Ex.PersistEntityBackend record ~ SqlBackend) =>
                            EntityField record typ -> (record -> b) -> m (Maybe b)
defaultGetLastAppliedEventId :: forall record (m :: * -> *) typ b.
(PersistEntity record, Typeable record, MonadSqlQuery m,
 PersistEntityBackend record ~ SqlBackend) =>
EntityField record typ -> (record -> b) -> m (Maybe b)
defaultGetLastAppliedEventId EntityField record typ
sortField record -> b
extractId = do
    Maybe (Entity record)
lastEvent <- [Filter record] -> [SelectOpt record] -> m (Maybe (Entity record))
forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> [SelectOpt record] -> m (Maybe (Entity record))
selectFirst [] [EntityField record typ -> SelectOpt record
forall record typ. EntityField record typ -> SelectOpt record
Desc EntityField record typ
sortField]
    Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> m (Maybe b)) -> Maybe b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ (record -> b
extractId (record -> b) -> (Entity record -> record) -> Entity record -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity record -> record
forall record. Entity record -> record
entityVal) (Entity record -> b) -> Maybe (Entity record) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Entity record)
lastEvent

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


defaultLoadUnappliedEvents :: (Traversable t,
                    MonadSqlQuery m,
              PersistEntity val1, PersistEntity val2,
              PersistField a) =>
             EntityField val1 a -> EntityField val2 a -> t a -> m [Entity val1]
defaultLoadUnappliedEvents :: forall (t :: * -> *) (m :: * -> *) val1 val2 a.
(Traversable t, MonadSqlQuery m, PersistEntity val1,
 PersistEntity val2, PersistField a) =>
EntityField val1 a -> EntityField val2 a -> t a -> m [Entity val1]
defaultLoadUnappliedEvents EntityField val1 a
eventId EntityField val2 a
appliedId t a
mapplied = do
    SqlQuery (SqlExpr (Entity val1)) -> m [Entity val1]
forall (m :: * -> *) a r.
(MonadSqlQuery m, SqlSelect a r) =>
SqlQuery a -> m [r]
Ex.select (SqlQuery (SqlExpr (Entity val1)) -> m [Entity val1])
-> SqlQuery (SqlExpr (Entity val1)) -> m [Entity val1]
forall a b. (a -> b) -> a -> b
$ do
          SqlExpr (Entity val1)
event <- From (SqlExpr (Entity val1)) -> SqlQuery (SqlExpr (Entity val1))
forall a a'. ToFrom a a' => a -> SqlQuery a'
Ex.from (From (SqlExpr (Entity val1)) -> SqlQuery (SqlExpr (Entity val1)))
-> From (SqlExpr (Entity val1)) -> SqlQuery (SqlExpr (Entity val1))
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity val1))
forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
Ex.table
          SqlQuery (t ()) -> SqlQuery ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SqlQuery (t ()) -> SqlQuery ()) -> SqlQuery (t ()) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ t a -> (a -> SqlQuery ()) -> SqlQuery (t ())
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t a
mapplied ((a -> SqlQuery ()) -> SqlQuery (t ()))
-> (a -> SqlQuery ()) -> SqlQuery (t ())
forall a b. (a -> b) -> a -> b
$ \a
applied ->
            SqlExpr (Value Bool) -> SqlQuery ()
Ex.where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity val1)
event SqlExpr (Entity val1) -> EntityField val1 a -> SqlExpr (Value a)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
Ex.^. EntityField val1 a
eventId SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
Ex.>. a -> SqlExpr (Value a)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
Ex.val a
applied
          SqlExpr (Value Bool) -> SqlQuery ()
Ex.where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SqlQuery () -> SqlExpr (Value Bool)
Ex.notExists (SqlQuery () -> SqlExpr (Value Bool))
-> SqlQuery () -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ do
            SqlExpr (Entity val2)
applied <- From (SqlExpr (Entity val2)) -> SqlQuery (SqlExpr (Entity val2))
forall a a'. ToFrom a a' => a -> SqlQuery a'
Ex.from (From (SqlExpr (Entity val2)) -> SqlQuery (SqlExpr (Entity val2)))
-> From (SqlExpr (Entity val2)) -> SqlQuery (SqlExpr (Entity val2))
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity val2))
forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
Ex.table
            SqlExpr (Value Bool) -> SqlQuery ()
Ex.where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity val1)
event SqlExpr (Entity val1) -> EntityField val1 a -> SqlExpr (Value a)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
Ex.^. EntityField val1 a
eventId SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
Ex.==. SqlExpr (Entity val2)
applied SqlExpr (Entity val2) -> EntityField val2 a -> SqlExpr (Value a)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
Ex.^. EntityField val2 a
appliedId
          [SqlExpr OrderBy] -> SqlQuery ()
Ex.orderBy
            [ SqlExpr (Value a) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
Ex.asc (SqlExpr (Value a) -> SqlExpr OrderBy)
-> SqlExpr (Value a) -> SqlExpr OrderBy
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity val1)
event SqlExpr (Entity val1) -> EntityField val1 a -> SqlExpr (Value a)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
Ex.^. EntityField val1 a
eventId
            ]
          SqlExpr (Entity val1) -> SqlQuery (SqlExpr (Entity val1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlExpr (Entity val1)
event