module Web.Apiary.Database.Persist (
ApiaryPersistConfig
, defaultApiaryPersistConfig
, withWithSqlPool, withWithSqlPool'
, runSql, runSql'
, HasPersist, LogRunner
, module Database.Persist.Sql
) where
import Database.Persist.Sql
import Control.Monad.Logger
import Control.Monad.Trans
import Control.Monad.Trans.Resource
type HasPersist l =
?webApiaryDatabasePersistState :: ApiaryPersistState l
type LogRunner l = forall a. l (ResourceT IO) a -> ResourceT IO a
newtype ApiaryPersistConfig l = ApiaryPersistConfig
{ runLogger :: LogRunner l
}
defaultApiaryPersistConfig :: ApiaryPersistConfig NoLoggingT
defaultApiaryPersistConfig = ApiaryPersistConfig runNoLoggingT
data ApiaryPersistState l = ApiaryPersistState
{ runLogger' :: LogRunner l
, getPool :: ConnectionPool
}
runSql :: (MonadBaseControl IO (l (ResourceT IO)), MonadIO m, HasPersist l) => SqlPersistT (l (ResourceT IO)) a -> m a
runSql = runSql' (runLogger' ?webApiaryDatabasePersistState)
runSql' :: (MonadBaseControl IO logger, MonadIO m, HasPersist logger') => (logger a -> ResourceT IO b) -> SqlPersistT logger a -> m b
runSql' run a =
liftIO .
runResourceT .
run $
runSqlPool a (getPool ?webApiaryDatabasePersistState)
withWithSqlPool :: (forall a. (ConnectionPool -> m a) -> m a)
-> (HasPersist NoLoggingT => m b) -> m b
withWithSqlPool = withWithSqlPool' defaultApiaryPersistConfig
withWithSqlPool' :: ApiaryPersistConfig logger
-> (forall a. (ConnectionPool -> m a) -> m a)
-> (HasPersist logger => m b) -> m b
withWithSqlPool' conf with m = with $ \pool -> do
let ?webApiaryDatabasePersistState = ApiaryPersistState (runLogger conf) pool
m