{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Test.Syd.Persistent.Sqlite
( persistSqliteSpec,
withConnectionPool,
connectionPoolSetupFunc,
runSqlPool,
runSqliteTest,
migrationRunner,
)
where
import Control.Monad.Logger
import Control.Monad.Reader
import Database.Persist.Sql
import Database.Persist.Sqlite
import Test.Syd
import Test.Syd.Persistent
persistSqliteSpec :: Migration -> SpecWith ConnectionPool -> SpecWith a
persistSqliteSpec :: Migration -> SpecWith ConnectionPool -> SpecWith a
persistSqliteSpec Migration
migration = ((ConnectionPool -> IO ()) -> a -> IO ())
-> SpecWith ConnectionPool -> SpecWith a
forall newInner oldInner (outers :: [*]) result.
((newInner -> IO ()) -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith (((ConnectionPool -> IO ()) -> a -> IO ())
-> SpecWith ConnectionPool -> SpecWith a)
-> ((ConnectionPool -> IO ()) -> a -> IO ())
-> SpecWith ConnectionPool
-> SpecWith a
forall a b. (a -> b) -> a -> b
$ \ConnectionPool -> IO ()
func a
_ -> Migration -> (ConnectionPool -> IO ()) -> IO ()
forall r. Migration -> (ConnectionPool -> IO r) -> IO r
withConnectionPool Migration
migration ConnectionPool -> IO ()
func
withConnectionPool :: Migration -> (ConnectionPool -> IO r) -> IO r
withConnectionPool :: Migration -> (ConnectionPool -> IO r) -> IO r
withConnectionPool Migration
migration ConnectionPool -> IO r
func = SetupFunc ConnectionPool -> (ConnectionPool -> IO r) -> IO r
forall resource.
SetupFunc resource -> forall r. (resource -> IO r) -> IO r
unSetupFunc (Migration -> SetupFunc ConnectionPool
connectionPoolSetupFunc Migration
migration) ConnectionPool -> IO r
func
connectionPoolSetupFunc :: Migration -> SetupFunc ConnectionPool
connectionPoolSetupFunc :: Migration -> SetupFunc ConnectionPool
connectionPoolSetupFunc Migration
migration = (forall r. (ConnectionPool -> IO r) -> IO r)
-> SetupFunc ConnectionPool
forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc ((forall r. (ConnectionPool -> IO r) -> IO r)
-> SetupFunc ConnectionPool)
-> (forall r. (ConnectionPool -> IO r) -> IO r)
-> SetupFunc ConnectionPool
forall a b. (a -> b) -> a -> b
$ \ConnectionPool -> IO r
takeConnectionPool ->
NoLoggingT IO r -> IO r
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (NoLoggingT IO r -> IO r) -> NoLoggingT IO r -> IO r
forall a b. (a -> b) -> a -> b
$
Text
-> Int -> (ConnectionPool -> NoLoggingT IO r) -> NoLoggingT IO r
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> Int -> (ConnectionPool -> m a) -> m a
withSqlitePool Text
":memory:" Int
1 ((ConnectionPool -> NoLoggingT IO r) -> NoLoggingT IO r)
-> (ConnectionPool -> NoLoggingT IO r) -> NoLoggingT IO r
forall a b. (a -> b) -> a -> b
$ \ConnectionPool
pool -> do
()
_ <- (ReaderT SqlBackend (NoLoggingT IO) ()
-> ConnectionPool -> NoLoggingT IO ())
-> ConnectionPool
-> ReaderT SqlBackend (NoLoggingT IO) ()
-> NoLoggingT IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT SqlBackend (NoLoggingT IO) ()
-> ConnectionPool -> NoLoggingT IO ()
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
runSqlPool ConnectionPool
pool (ReaderT SqlBackend (NoLoggingT IO) () -> NoLoggingT IO ())
-> ReaderT SqlBackend (NoLoggingT IO) () -> NoLoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Migration -> ReaderT SqlBackend (NoLoggingT IO) ()
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
migrationRunner Migration
migration
IO r -> NoLoggingT IO r
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO r -> NoLoggingT IO r) -> IO r -> NoLoggingT IO r
forall a b. (a -> b) -> a -> b
$ ConnectionPool -> IO r
takeConnectionPool ConnectionPool
pool
runSqliteTest :: ConnectionPool -> SqlPersistM a -> IO a
runSqliteTest :: ConnectionPool -> SqlPersistM a -> IO a
runSqliteTest = ConnectionPool -> SqlPersistM a -> IO a
forall a. ConnectionPool -> SqlPersistM a -> IO a
runPersistentTest