{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}

module Database.Beam.Migrate.Types
  ( -- * Checked database entities
    CheckedDatabaseSettings

  , IsCheckedDatabaseEntity(..)
  , CheckedDatabaseEntityDescriptor(..)
  , CheckedDatabaseEntity(..)

  , unCheckDatabase, collectChecks
  , renameCheckedEntity

    -- ** Modifyinging checked entities
    --
    --    The functions in this section can be used to modify 'CheckedDatabaseSettings' objects.
  , CheckedFieldModification
  , checkedFieldNamed

  , modifyCheckedTable
  , checkedTableModification

    -- * Predicates
  , DatabasePredicate(..)
  , SomeDatabasePredicate(..)
  , PredicateSpecificity(..)
  , QualifiedName(..)

  , p

    -- * Entity checks
  , TableCheck(..), DomainCheck(..)
  , FieldCheck(..)

    -- * Migrations
  , MigrationStep(..), MigrationSteps(..)
  , Migration, MigrationF(..)

  , MigrationCommand(..), MigrationDataLoss(..)

  , runMigrationSteps, runMigrationSilenced
  , executeMigration, eraseMigrationType, migrationStep
  , upDown, migrationDataLoss

  , migrateScript, evaluateDatabase, stepNames ) where

import Database.Beam.Backend.SQL
import Database.Beam.Migrate.Types.CheckedEntities
import Database.Beam.Migrate.Types.Predicates
import Control.Monad.Free.Church
import Control.Arrow
import Control.Category (Category)

#if !MIN_VERSION_base(4, 11, 0)
import Data.Semigroup
#endif
import Data.Text (Text)

-- * Migration types

-- | Represents a particular step in a migration
data MigrationStep be next where
    MigrationStep :: Text -> Migration be a -> (a -> next) -> MigrationStep be next
deriving instance Functor (MigrationStep be)

-- | A series of 'MigrationStep's that take a database from the schema in @from@
-- to the one in @to@. Use the 'migrationStep' function and the arrow interface
-- to sequence 'MigrationSteps'.
newtype MigrationSteps be from to = MigrationSteps (Kleisli (F (MigrationStep be)) from to)
  deriving (MigrationSteps be a a
MigrationSteps be b c
-> MigrationSteps be a b -> MigrationSteps be a c
(forall a. MigrationSteps be a a)
-> (forall b c a.
    MigrationSteps be b c
    -> MigrationSteps be a b -> MigrationSteps be a c)
-> Category (MigrationSteps be)
forall a. MigrationSteps be a a
forall be a. MigrationSteps be a a
forall b c a.
MigrationSteps be b c
-> MigrationSteps be a b -> MigrationSteps be a c
forall be b c a.
MigrationSteps be b c
-> MigrationSteps be a b -> MigrationSteps be a c
forall k (cat :: k -> k -> *).
(forall (a :: k). cat a a)
-> (forall (b :: k) (c :: k) (a :: k).
    cat b c -> cat a b -> cat a c)
-> Category cat
. :: MigrationSteps be b c
-> MigrationSteps be a b -> MigrationSteps be a c
$c. :: forall be b c a.
MigrationSteps be b c
-> MigrationSteps be a b -> MigrationSteps be a c
id :: MigrationSteps be a a
$cid :: forall be a. MigrationSteps be a a
Category, Category (MigrationSteps be)
Category (MigrationSteps be)
-> (forall b c. (b -> c) -> MigrationSteps be b c)
-> (forall b c d.
    MigrationSteps be b c -> MigrationSteps be (b, d) (c, d))
-> (forall b c d.
    MigrationSteps be b c -> MigrationSteps be (d, b) (d, c))
-> (forall b c b' c'.
    MigrationSteps be b c
    -> MigrationSteps be b' c' -> MigrationSteps be (b, b') (c, c'))
-> (forall b c c'.
    MigrationSteps be b c
    -> MigrationSteps be b c' -> MigrationSteps be b (c, c'))
-> Arrow (MigrationSteps be)
MigrationSteps be b c -> MigrationSteps be (b, d) (c, d)
MigrationSteps be b c -> MigrationSteps be (d, b) (d, c)
MigrationSteps be b c
-> MigrationSteps be b' c' -> MigrationSteps be (b, b') (c, c')
MigrationSteps be b c
-> MigrationSteps be b c' -> MigrationSteps be b (c, c')
(b -> c) -> MigrationSteps be b c
forall be. Category (MigrationSteps be)
forall b c. (b -> c) -> MigrationSteps be b c
forall b c d.
MigrationSteps be b c -> MigrationSteps be (b, d) (c, d)
forall b c d.
MigrationSteps be b c -> MigrationSteps be (d, b) (d, c)
forall b c c'.
MigrationSteps be b c
-> MigrationSteps be b c' -> MigrationSteps be b (c, c')
forall be b c. (b -> c) -> MigrationSteps be b c
forall be b c d.
MigrationSteps be b c -> MigrationSteps be (b, d) (c, d)
forall be b c d.
MigrationSteps be b c -> MigrationSteps be (d, b) (d, c)
forall be b c c'.
MigrationSteps be b c
-> MigrationSteps be b c' -> MigrationSteps be b (c, c')
forall b c b' c'.
MigrationSteps be b c
-> MigrationSteps be b' c' -> MigrationSteps be (b, b') (c, c')
forall be b c b' c'.
MigrationSteps be b c
-> MigrationSteps be b' c' -> MigrationSteps be (b, b') (c, c')
forall (a :: * -> * -> *).
Category a
-> (forall b c. (b -> c) -> a b c)
-> (forall b c d. a b c -> a (b, d) (c, d))
-> (forall b c d. a b c -> a (d, b) (d, c))
-> (forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c'))
-> (forall b c c'. a b c -> a b c' -> a b (c, c'))
-> Arrow a
&&& :: MigrationSteps be b c
-> MigrationSteps be b c' -> MigrationSteps be b (c, c')
$c&&& :: forall be b c c'.
MigrationSteps be b c
-> MigrationSteps be b c' -> MigrationSteps be b (c, c')
*** :: MigrationSteps be b c
-> MigrationSteps be b' c' -> MigrationSteps be (b, b') (c, c')
$c*** :: forall be b c b' c'.
MigrationSteps be b c
-> MigrationSteps be b' c' -> MigrationSteps be (b, b') (c, c')
second :: MigrationSteps be b c -> MigrationSteps be (d, b) (d, c)
$csecond :: forall be b c d.
MigrationSteps be b c -> MigrationSteps be (d, b) (d, c)
first :: MigrationSteps be b c -> MigrationSteps be (b, d) (c, d)
$cfirst :: forall be b c d.
MigrationSteps be b c -> MigrationSteps be (b, d) (c, d)
arr :: (b -> c) -> MigrationSteps be b c
$carr :: forall be b c. (b -> c) -> MigrationSteps be b c
$cp1Arrow :: forall be. Category (MigrationSteps be)
Arrow)

-- | Free monadic function for 'Migration's
data MigrationF be next where
  MigrationRunCommand
    :: { MigrationF be next -> BeamSqlBackendSyntax be
_migrationUpCommand   :: BeamSqlBackendSyntax be
       -- ^ What to execute when applying the migration
       , MigrationF be next -> Maybe (BeamSqlBackendSyntax be)
_migrationDownCommand :: Maybe (BeamSqlBackendSyntax be)
       -- ^ What to execute when unapplying the migration
       , MigrationF be next -> next
_migrationNext :: next }
    -> MigrationF be next
deriving instance Functor (MigrationF be)

-- | A sequence of potentially reversible schema update commands
type Migration be = F (MigrationF be)

-- | Information on whether a 'MigrationCommand' loses data. You can
-- monoidally combine these to get the potential data loss for a
-- sequence of commands.
data MigrationDataLoss
  = MigrationLosesData
    -- ^ The command loses data
  | MigrationKeepsData
    -- ^ The command keeps all data
  deriving Int -> MigrationDataLoss -> ShowS
[MigrationDataLoss] -> ShowS
MigrationDataLoss -> String
(Int -> MigrationDataLoss -> ShowS)
-> (MigrationDataLoss -> String)
-> ([MigrationDataLoss] -> ShowS)
-> Show MigrationDataLoss
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrationDataLoss] -> ShowS
$cshowList :: [MigrationDataLoss] -> ShowS
show :: MigrationDataLoss -> String
$cshow :: MigrationDataLoss -> String
showsPrec :: Int -> MigrationDataLoss -> ShowS
$cshowsPrec :: Int -> MigrationDataLoss -> ShowS
Show

instance Semigroup MigrationDataLoss where
    <> :: MigrationDataLoss -> MigrationDataLoss -> MigrationDataLoss
(<>) = MigrationDataLoss -> MigrationDataLoss -> MigrationDataLoss
forall a. Monoid a => a -> a -> a
mappend

instance Monoid MigrationDataLoss where
    mempty :: MigrationDataLoss
mempty = MigrationDataLoss
MigrationKeepsData
    mappend :: MigrationDataLoss -> MigrationDataLoss -> MigrationDataLoss
mappend MigrationDataLoss
MigrationLosesData MigrationDataLoss
_ = MigrationDataLoss
MigrationLosesData
    mappend MigrationDataLoss
_ MigrationDataLoss
MigrationLosesData = MigrationDataLoss
MigrationLosesData
    mappend MigrationDataLoss
MigrationKeepsData MigrationDataLoss
MigrationKeepsData = MigrationDataLoss
MigrationKeepsData

-- | A migration command along with metadata on whether the command can lose data
data MigrationCommand be
  = MigrationCommand
  { MigrationCommand be -> BeamSqlBackendSyntax be
migrationCommand :: BeamSqlBackendSyntax be
    -- ^ The command to run
  , MigrationCommand be -> MigrationDataLoss
migrationCommandDataLossPossible :: MigrationDataLoss
    -- ^ Information on whether the migration loses data
  }
deriving instance Show (BeamSqlBackendSyntax be) => Show (MigrationCommand be)

-- | Run the migration steps between the given indices, using a custom execution function.
runMigrationSteps :: Monad m
                  => Int -- ^ Zero-based index of the first step to run
                  -> Maybe Int -- ^ Index of the last step to run, or 'Nothing' to run every step
                  -> MigrationSteps be () a -- ^ The set of steps to run
                  -> (forall a'. Int -> Text -> Migration be a' -> m a')
                  -- ^ Callback for each step. Called with the step index, the
                  -- step description and the migration.
                  -> m a
runMigrationSteps :: Int
-> Maybe Int
-> MigrationSteps be () a
-> (forall a'. Int -> Text -> Migration be a' -> m a')
-> m a
runMigrationSteps Int
firstIdx Maybe Int
lastIdx (MigrationSteps Kleisli (F (MigrationStep be)) () a
steps) forall a'. Int -> Text -> Migration be a' -> m a'
runMigration =
  F (MigrationStep be) a
-> (a -> Int -> m a)
-> (MigrationStep be (Int -> m a) -> Int -> m a)
-> Int
-> m a
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF (Kleisli (F (MigrationStep be)) () a -> () -> F (MigrationStep be) a
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli (F (MigrationStep be)) () a
steps ()) a -> Int -> m a
forall (f :: * -> *) a p. Applicative f => a -> p -> f a
finish MigrationStep be (Int -> m a) -> Int -> m a
step Int
0
  where finish :: a -> p -> f a
finish a
x p
_ = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        step :: MigrationStep be (Int -> m a) -> Int -> m a
step (MigrationStep Text
nm Migration be a
doStep a -> Int -> m a
next) Int
i =
          if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
firstIdx Bool -> Bool -> Bool
&& Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<) Maybe Int
lastIdx
          then Int -> Text -> Migration be a -> m a
forall a'. Int -> Text -> Migration be a' -> m a'
runMigration Int
i Text
nm Migration be a
doStep m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> a -> Int -> m a
next a
x (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          else a -> Int -> m a
next (Migration be a -> a
forall be a. Migration be a -> a
runMigrationSilenced Migration be a
doStep) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Get the result of a migration, without running any steps
runMigrationSilenced :: Migration be a -> a
runMigrationSilenced :: Migration be a -> a
runMigrationSilenced Migration be a
m = Migration be a -> (a -> a) -> (MigrationF be a -> a) -> a
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF Migration be a
m a -> a
forall a. a -> a
id MigrationF be a -> a
forall be next. MigrationF be next -> next
step
  where
    step :: MigrationF be next -> next
step (MigrationRunCommand BeamSqlBackendSyntax be
_ Maybe (BeamSqlBackendSyntax be)
_ next
next) = next
next

-- | Remove the explicit source and destination schemas from a 'MigrationSteps' object
eraseMigrationType :: a -> MigrationSteps be a a' -> MigrationSteps be () ()
eraseMigrationType :: a -> MigrationSteps be a a' -> MigrationSteps be () ()
eraseMigrationType a
a (MigrationSteps Kleisli (F (MigrationStep be)) a a'
steps) = Kleisli (F (MigrationStep be)) () () -> MigrationSteps be () ()
forall be from to.
Kleisli (F (MigrationStep be)) from to -> MigrationSteps be from to
MigrationSteps ((() -> a) -> Kleisli (F (MigrationStep be)) () a
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a -> () -> a
forall a b. a -> b -> a
const a
a) Kleisli (F (MigrationStep be)) () a
-> Kleisli (F (MigrationStep be)) a ()
-> Kleisli (F (MigrationStep be)) () ()
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Kleisli (F (MigrationStep be)) a a'
steps Kleisli (F (MigrationStep be)) a a'
-> Kleisli (F (MigrationStep be)) a' ()
-> Kleisli (F (MigrationStep be)) a ()
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (a' -> ()) -> Kleisli (F (MigrationStep be)) a' ()
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (() -> a' -> ()
forall a b. a -> b -> a
const ()))

-- | Create a 'MigrationSteps' from the given description and migration function.
migrationStep :: Text -> (a -> Migration be a') -> MigrationSteps be a a'
migrationStep :: Text -> (a -> Migration be a') -> MigrationSteps be a a'
migrationStep Text
stepName a -> Migration be a'
migration =
    Kleisli (F (MigrationStep be)) a a' -> MigrationSteps be a a'
forall be from to.
Kleisli (F (MigrationStep be)) from to -> MigrationSteps be from to
MigrationSteps ((a -> F (MigrationStep be) a')
-> Kleisli (F (MigrationStep be)) a a'
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (\a
a -> MigrationStep be a' -> F (MigrationStep be) a'
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (Text -> Migration be a' -> (a' -> a') -> MigrationStep be a'
forall be a next.
Text -> Migration be a -> (a -> next) -> MigrationStep be next
MigrationStep Text
stepName (a -> Migration be a'
migration a
a) a' -> a'
forall a. a -> a
id)))

-- | Given a command in the forward direction, and an optional one in the
-- reverse direction, construct a 'Migration' that performs the given
-- command. Multiple commands can be sequenced monadically.
upDown :: BeamSqlBackendSyntax be -> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown :: BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown BeamSqlBackendSyntax be
up Maybe (BeamSqlBackendSyntax be)
down = MigrationF be () -> Migration be ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> () -> MigrationF be ()
forall be next.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> next -> MigrationF be next
MigrationRunCommand BeamSqlBackendSyntax be
up Maybe (BeamSqlBackendSyntax be)
down ())

-- | Given functions to render a migration step description and the underlying
-- syntax, create a script for the given 'MigrationSteps'.
migrateScript :: forall be m a. (Monoid m, Semigroup m, BeamSqlBackend be)
              => (Text -> m)
              -- ^ Called at the beginning of each 'MigrationStep' with the step description
              -> (BeamSqlBackendSyntax be -> m)
              -- ^ Called for each command in the migration step
              -> MigrationSteps be () a
              -- ^ The set of steps to run
              -> m
migrateScript :: (Text -> m)
-> (BeamSqlBackendSyntax be -> m) -> MigrationSteps be () a -> m
migrateScript Text -> m
renderMigrationHeader BeamSqlBackendSyntax be -> m
renderMigrationSyntax (MigrationSteps Kleisli (F (MigrationStep be)) () a
steps) =
  F (MigrationStep be) a
-> (a -> m -> m) -> (MigrationStep be (m -> m) -> m -> m) -> m -> m
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF (Kleisli (F (MigrationStep be)) () a -> () -> F (MigrationStep be) a
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli (F (MigrationStep be)) () a
steps ()) (\a
_ m
x -> m
x)
    (\(MigrationStep Text
header Migration be a
migration a -> m -> m
next) m
x ->
       let (a
res, m
script) = Migration be a -> m -> (a, m)
forall a'. Migration be a' -> m -> (a', m)
renderMigration Migration be a
migration m
forall a. Monoid a => a
mempty
       in a -> m -> m
next a
res (m
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Text -> m
renderMigrationHeader Text
header m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
script)) m
forall a. Monoid a => a
mempty
  where
    renderMigration :: forall a'. Migration be a' -> m -> (a', m)
    renderMigration :: Migration be a' -> m -> (a', m)
renderMigration Migration be a'
migrationSteps =
      Migration be a'
-> (a' -> m -> (a', m))
-> (MigrationF be (m -> (a', m)) -> m -> (a', m))
-> m
-> (a', m)
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF Migration be a'
migrationSteps (,)
           (\(MigrationRunCommand BeamSqlBackendSyntax be
a Maybe (BeamSqlBackendSyntax be)
_ m -> (a', m)
next) m
x -> m -> (a', m)
next (m
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> BeamSqlBackendSyntax be -> m
renderMigrationSyntax BeamSqlBackendSyntax be
a))

-- | Execute a given migration, provided a command to execute arbitrary syntax.
--   You usually use this with 'runNoReturn'.
executeMigration :: Applicative m => (BeamSqlBackendSyntax be -> m ()) -> Migration be a -> m a
executeMigration :: (BeamSqlBackendSyntax be -> m ()) -> Migration be a -> m a
executeMigration BeamSqlBackendSyntax be -> m ()
runSyntax Migration be a
go = Migration be a -> (a -> m a) -> (MigrationF be (m a) -> m a) -> m a
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF Migration be a
go a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationF be (m a) -> m a
doStep
  where
    doStep :: MigrationF be (m a) -> m a
doStep (MigrationRunCommand BeamSqlBackendSyntax be
cmd Maybe (BeamSqlBackendSyntax be)
_ m a
next) =
      BeamSqlBackendSyntax be -> m ()
runSyntax BeamSqlBackendSyntax be
cmd m () -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
next

-- | Given a migration, get the potential data loss, if it's run top-down
migrationDataLoss :: Migration be a -> MigrationDataLoss
migrationDataLoss :: Migration be a -> MigrationDataLoss
migrationDataLoss Migration be a
go = Migration be a
-> (a -> MigrationDataLoss)
-> (MigrationF be MigrationDataLoss -> MigrationDataLoss)
-> MigrationDataLoss
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF Migration be a
go (\a
_ -> MigrationDataLoss
MigrationKeepsData)
                         (\(MigrationRunCommand BeamSqlBackendSyntax be
_ Maybe (BeamSqlBackendSyntax be)
x MigrationDataLoss
next) ->
                            case Maybe (BeamSqlBackendSyntax be)
x of
                              Maybe (BeamSqlBackendSyntax be)
Nothing -> MigrationDataLoss
MigrationLosesData
                              Maybe (BeamSqlBackendSyntax be)
_ -> MigrationDataLoss
next)

-- | Run a 'MigrationSteps' without executing any of the commands against a
-- database.
evaluateDatabase :: forall be a. MigrationSteps be () a -> a
evaluateDatabase :: MigrationSteps be () a -> a
evaluateDatabase (MigrationSteps Kleisli (F (MigrationStep be)) () a
f) = F (MigrationStep be) a
-> (a -> a) -> (MigrationStep be a -> a) -> a
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF (Kleisli (F (MigrationStep be)) () a -> () -> F (MigrationStep be) a
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli (F (MigrationStep be)) () a
f ()) a -> a
forall a. a -> a
id (\(MigrationStep Text
_ Migration be a
migration a -> a
next) -> a -> a
next (Migration be a -> a
forall a'. Migration be a' -> a'
runMigration Migration be a
migration))
  where
    runMigration :: forall a'. Migration be a' -> a'
    runMigration :: Migration be a' -> a'
runMigration Migration be a'
migration = Migration be a' -> (a' -> a') -> (MigrationF be a' -> a') -> a'
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF Migration be a'
migration a' -> a'
forall a. a -> a
id (\(MigrationRunCommand BeamSqlBackendSyntax be
_ Maybe (BeamSqlBackendSyntax be)
_ a'
next) -> a'
next)

-- | Collect the names of all steps in hte given 'MigrationSteps'
stepNames :: forall be a. MigrationSteps be () a -> [Text]
stepNames :: MigrationSteps be () a -> [Text]
stepNames (MigrationSteps Kleisli (F (MigrationStep be)) () a
f) = F (MigrationStep be) a
-> (a -> [Text] -> [Text])
-> (MigrationStep be ([Text] -> [Text]) -> [Text] -> [Text])
-> [Text]
-> [Text]
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF (Kleisli (F (MigrationStep be)) () a -> () -> F (MigrationStep be) a
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli (F (MigrationStep be)) () a
f ()) (\a
_ [Text]
x -> [Text]
x) (\(MigrationStep Text
nm Migration be a
migration a -> [Text] -> [Text]
next) [Text]
x -> a -> [Text] -> [Text]
next (Migration be a -> a
forall a'. Migration be a' -> a'
runMigration Migration be a
migration) ([Text]
x [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
nm])) []
  where
    runMigration :: forall a'. Migration be a' -> a'
    runMigration :: Migration be a' -> a'
runMigration Migration be a'
migration = Migration be a' -> (a' -> a') -> (MigrationF be a' -> a') -> a'
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF Migration be a'
migration a' -> a'
forall a. a -> a
id (\(MigrationRunCommand BeamSqlBackendSyntax be
_ Maybe (BeamSqlBackendSyntax be)
_ a'
next) -> a'
next)