{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Testing with an in-memory sqlite database using persistent-sqlite
module Test.Syd.Persistent
  ( runSqlPool,
    runPersistentTest,
    migrationRunner,
  )
where

import Control.Monad.Reader
import Database.Persist.Sql
import Test.Syd

instance IsTest (SqlPersistM ()) where
  type Arg1 (SqlPersistM ()) = ()
  type Arg2 (SqlPersistM ()) = ConnectionPool
  runTest :: SqlPersistM ()
-> TestRunSettings
-> ((Arg1 (SqlPersistM ()) -> Arg2 (SqlPersistM ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest SqlPersistM ()
func = (() -> SqlPersistM ())
-> TestRunSettings
-> ((Arg1 (() -> SqlPersistM ())
     -> Arg2 (() -> SqlPersistM ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() -> SqlPersistM ()
func)

instance IsTest (outerArgs -> SqlPersistM ()) where
  type Arg1 (outerArgs -> SqlPersistM ()) = outerArgs
  type Arg2 (outerArgs -> SqlPersistM ()) = ConnectionPool
  runTest :: (outerArgs -> SqlPersistM ())
-> TestRunSettings
-> ((Arg1 (outerArgs -> SqlPersistM ())
     -> Arg2 (outerArgs -> SqlPersistM ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest outerArgs -> SqlPersistM ()
func = (outerArgs -> ConnectionPool -> IO ())
-> TestRunSettings
-> ((Arg1 (outerArgs -> ConnectionPool -> IO ())
     -> Arg2 (outerArgs -> ConnectionPool -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\outerArgs
outerArgs ConnectionPool
pool -> ConnectionPool -> SqlPersistM () -> IO ()
forall a. ConnectionPool -> SqlPersistM a -> IO a
runPersistentTest ConnectionPool
pool (outerArgs -> SqlPersistM ()
func outerArgs
outerArgs))

-- | A flipped version of 'runSqlPool' to run your tests
runPersistentTest :: ConnectionPool -> SqlPersistM a -> IO a
runPersistentTest :: ConnectionPool -> SqlPersistM a -> IO a
runPersistentTest = (SqlPersistM a -> ConnectionPool -> IO a)
-> ConnectionPool -> SqlPersistM a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip SqlPersistM a -> ConnectionPool -> IO a
forall backend a.
BackendCompatible SqlBackend backend =>
ReaderT backend (NoLoggingT (ResourceT IO)) a
-> Pool backend -> IO a
runSqlPersistMPool

-- | Helper function to run a 'Migration' before/in a test suite that works accross versions of @persistent@.
#if MIN_VERSION_persistent(2,10,2)
migrationRunner :: MonadIO m => Migration -> ReaderT SqlBackend m ()
migrationRunner :: Migration -> ReaderT SqlBackend m ()
migrationRunner = ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ())
-> (Migration -> ReaderT SqlBackend m [Text])
-> Migration
-> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m [Text]
runMigrationQuiet
#else
migrationRunner :: MonadIO m => Migration -> ReaderT SqlBackend m ()
migrationRunner = runMigration
#endif