module Polysemy.Hasql.Test.Migration where

import qualified Data.Text as Text
import Hedgehog.Internal.Property (failWith)
import Path (reldir)
import Polysemy.Db.Data.DbError (DbError)
import qualified Polysemy.Test as Test
import Polysemy.Test (Hedgehog, Test, liftH)
import Sqel.Data.Migration (Migrations)
import Sqel.Migration.Consistency (migrationConsistency)

import Polysemy.Hasql.Effect.Database (Database)

testMigration' ::
  Members [Test, Hedgehog IO, Embed IO] r =>
  Migrations r' old cur ->
  Bool ->
  Sem r ()
testMigration' :: forall (r :: EffectRow) (r' :: * -> *) (old :: [*]) cur.
Members '[Test, Hedgehog IO, Embed IO] r =>
Migrations r' old cur -> Bool -> Sem r ()
testMigration' Migrations r' old cur
migs Bool
write =
  forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack do
    Path Abs Dir
dir <- forall p (r :: EffectRow).
Member Test r =>
Path Rel p -> Sem r (Path Abs p)
Test.fixturePath [reldir|migration|]
    forall (m :: * -> *) (n :: * -> *) (old :: [*]) cur.
MonadIO m =>
Path Abs Dir
-> Migrations n old cur -> Bool -> m (Maybe (NonEmpty Text))
migrationConsistency Path Abs Dir
dir Migrations r' old cur
migs Bool
write forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just NonEmpty Text
errors ->
        forall (m :: * -> *) a (r :: EffectRow).
Member (Hedgehog m) r =>
TestT m a -> Sem r a
liftH (forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> FilePath -> m a
failWith forall a. Maybe a
Nothing (forall a. ToString a => a -> FilePath
toString (Text -> [Text] -> Text
Text.intercalate Text
"\n" (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Text
errors))))
      Maybe (NonEmpty Text)
Nothing -> forall (f :: * -> *). Applicative f => f ()
unit

testMigration ::
  Members [Test, Hedgehog IO, Embed IO] r =>
  Migrations (Sem (Database !! DbError : Stop DbError : r)) old cur ->
  Bool ->
  Sem r ()
testMigration :: forall (r :: EffectRow) (old :: [*]) cur.
Members '[Test, Hedgehog IO, Embed IO] r =>
Migrations (Sem ((Database !! DbError) : Stop DbError : r)) old cur
-> Bool -> Sem r ()
testMigration Migrations (Sem ((Database !! DbError) : Stop DbError : r)) old cur
write =
  forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack do
    forall (r :: EffectRow) (r' :: * -> *) (old :: [*]) cur.
Members '[Test, Hedgehog IO, Embed IO] r =>
Migrations r' old cur -> Bool -> Sem r ()
testMigration' Migrations (Sem ((Database !! DbError) : Stop DbError : r)) old cur
write