{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Testing with a temporary postgresql database using persistent-postgresql
module Test.Syd.Persistent.Postgresql
  ( persistPostgresqlSpec,
    withConnectionPool,
    connectionPoolSetupFunc,
    runSqlPool,
    runPostgresqlTest,
    postgresqlMigrationSucceedsSpec,
  )
where

import Control.Monad.Logger
import Control.Monad.Reader
import Database.Persist.Postgresql
import Database.Postgres.Temp as Temp
import Test.Syd
import Test.Syd.Persistent

-- | Declare a test suite that uses a database connection.
--
-- Example usage
--
-- > -- Database definition
-- > share
-- >   [mkPersist sqlSettings, mkMigrate "migrateExample"]
-- >   [persistLowerCase|
-- > Person
-- >     name String
-- >     age Int Maybe
-- >     deriving Show Eq
-- > |]
-- >
-- > -- Tests
-- > spec :: Spec
-- > spec =
-- >   persistPostgresqlSpec migrateExample $ do
-- >     it "can write and read this example person" $ \pool ->
-- >       runPostgresqlTest pool $ do
-- >         let p = Person {personName = "John Doe", personAge = Just 21}
-- >         i <- insert p
-- >         mp <- get i
-- >         liftIO $ mp `shouldBe` Just p
--
-- This sets up the database connection around every test, so state is not preserved accross tests.
persistPostgresqlSpec :: Migration -> SpecWith ConnectionPool -> SpecWith a
persistPostgresqlSpec :: Migration -> SpecWith ConnectionPool -> SpecWith a
persistPostgresqlSpec 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

-- | Set up a postgresql connection and migrate it to run the given function.
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

-- | The 'SetupFunc' version of 'withConnectionPool'.
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 -> do
  Either StartError r
errOrRes <- (DB -> IO r) -> IO (Either StartError r)
forall a. (DB -> IO a) -> IO (Either StartError a)
Temp.with ((DB -> IO r) -> IO (Either StartError r))
-> (DB -> IO r) -> IO (Either StartError r)
forall a b. (a -> b) -> a -> b
$ \DB
db ->
    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
$
      ConnectionString
-> Int -> (ConnectionPool -> NoLoggingT IO r) -> NoLoggingT IO r
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
ConnectionString -> Int -> (ConnectionPool -> m a) -> m a
withPostgresqlPool (DB -> ConnectionString
toConnectionString DB
db) 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
  case Either StartError r
errOrRes of
    Left StartError
err -> IO r -> IO r
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO r -> IO r) -> IO r -> IO r
forall a b. (a -> b) -> a -> b
$ String -> IO r
forall a. HasCallStack => String -> IO a
expectationFailure (String -> IO r) -> String -> IO r
forall a b. (a -> b) -> a -> b
$ StartError -> String
forall a. Show a => a -> String
show StartError
err
    Right r
r -> r -> IO r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r

-- | A flipped version of 'runSqlPool' to run your tests
runPostgresqlTest :: ConnectionPool -> SqlPersistM a -> IO a
runPostgresqlTest :: ConnectionPool -> SqlPersistM a -> IO a
runPostgresqlTest = ConnectionPool -> SqlPersistM a -> IO a
forall a. ConnectionPool -> SqlPersistM a -> IO a
runPersistentTest

-- | Test that the given migration succeeds, when applied to the current database.
--
-- See 'Test.Syd.Persistent.migrationsSucceedsSpec" for details.
postgresqlMigrationSucceedsSpec :: FilePath -> Migration -> Spec
postgresqlMigrationSucceedsSpec :: String -> Migration -> Spec
postgresqlMigrationSucceedsSpec = (Migration -> SetupFunc ConnectionPool)
-> String -> Migration -> Spec
migrationsSucceedsSpecHelper Migration -> SetupFunc ConnectionPool
connectionPoolSetupFunc