module Polysemy.Hasql.Test.Migration where

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

testMigration' ::
  ∀ migs r .
  Members [Test, Hedgehog IO, Embed IO] r =>
  Migrations (Sem r) migs ->
  Bool ->
  Sem r ()
testMigration' :: forall (migs :: [Mig]) (r :: EffectRow).
Members '[Test, Hedgehog IO, Embed IO] r =>
Migrations (Sem r) migs -> Bool -> Sem r ()
testMigration' Migrations (Sem r) migs
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 :: * -> *) (migs :: [Mig]).
MonadIO m =>
Path Abs Dir
-> Migrations m migs -> Bool -> m (Maybe (NonEmpty Text))
migrationConsistency Path Abs Dir
dir Migrations (Sem r) migs
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 ::
  ∀ migs r .
  Members [Test, Hedgehog IO, Embed IO] r =>
  Migrations (Sem r) migs ->
  Bool ->
  Sem r ()
testMigration :: forall (migs :: [Mig]) (r :: EffectRow).
Members '[Test, Hedgehog IO, Embed IO] r =>
Migrations (Sem r) migs -> Bool -> Sem r ()
testMigration Migrations (Sem r) migs
migs Bool
write =
  forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack do
    forall (migs :: [Mig]) (r :: EffectRow).
Members '[Test, Hedgehog IO, Embed IO] r =>
Migrations (Sem r) migs -> Bool -> Sem r ()
testMigration' Migrations (Sem r) migs
migs Bool
write