module Database.Persist.Sql.Migration
  ( parseMigration
  , parseMigration'
  , printMigration
  , showMigration
  , getMigration
  , runMigration
  , runMigrationQuiet
  , runMigrationSilent
  , runMigrationUnsafe
  , runMigrationUnsafeQuiet
  , migrate
  -- * Utilities for constructing migrations
  , reportErrors
  , reportError
  , addMigrations
  , addMigration
  , runSqlCommand
  ) where


import Control.Exception (throwIO)
import Control.Monad (liftM, unless)
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Monad.Trans.Reader (ReaderT (..), ask)
import Control.Monad.Trans.Writer
import Data.Text (Text, unpack, snoc, isPrefixOf, pack)
import qualified Data.Text.IO
import System.IO
import System.IO.Silently (hSilence)
import GHC.Stack

import Database.Persist.Sql.Types
import Database.Persist.Sql.Types.Internal
import Database.Persist.Sql.Raw
import Database.Persist.Types
import Database.Persist.Sql.Orphan.PersistStore()

allSql :: CautiousMigration -> [Sql]
allSql :: CautiousMigration -> [Sql]
allSql = ((Bool, Sql) -> Sql) -> CautiousMigration -> [Sql]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Sql) -> Sql
forall a b. (a, b) -> b
snd
safeSql :: CautiousMigration -> [Sql]
safeSql :: CautiousMigration -> [Sql]
safeSql = CautiousMigration -> [Sql]
allSql (CautiousMigration -> [Sql])
-> (CautiousMigration -> CautiousMigration)
-> CautiousMigration
-> [Sql]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, Sql) -> Bool) -> CautiousMigration -> CautiousMigration
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Bool, Sql) -> Bool) -> (Bool, Sql) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, Sql) -> Bool
forall a b. (a, b) -> a
fst)

-- | Given a 'Migration', this parses it and returns either a list of
-- errors associated with the migration or a list of migrations to do.
parseMigration :: (HasCallStack, MonadIO m) => Migration -> ReaderT SqlBackend m (Either [Text] CautiousMigration)
parseMigration :: Migration -> ReaderT SqlBackend m (Either [Sql] CautiousMigration)
parseMigration =
    ReaderT SqlBackend IO (Either [Sql] CautiousMigration)
-> ReaderT SqlBackend m (Either [Sql] CautiousMigration)
forall (m :: * -> *) r a.
MonadIO m =>
ReaderT r IO a -> ReaderT r m a
liftIOReader (ReaderT SqlBackend IO (Either [Sql] CautiousMigration)
 -> ReaderT SqlBackend m (Either [Sql] CautiousMigration))
-> (Migration
    -> ReaderT SqlBackend IO (Either [Sql] CautiousMigration))
-> Migration
-> ReaderT SqlBackend m (Either [Sql] CautiousMigration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Sql], CautiousMigration) -> Either [Sql] CautiousMigration)
-> ReaderT SqlBackend IO ([Sql], CautiousMigration)
-> ReaderT SqlBackend IO (Either [Sql] CautiousMigration)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Sql], CautiousMigration) -> Either [Sql] CautiousMigration
forall a b. ([a], b) -> Either [a] b
go (ReaderT SqlBackend IO ([Sql], CautiousMigration)
 -> ReaderT SqlBackend IO (Either [Sql] CautiousMigration))
-> (Migration -> ReaderT SqlBackend IO ([Sql], CautiousMigration))
-> Migration
-> ReaderT SqlBackend IO (Either [Sql] CautiousMigration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT CautiousMigration (ReaderT SqlBackend IO) [Sql]
-> ReaderT SqlBackend IO ([Sql], CautiousMigration)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT CautiousMigration (ReaderT SqlBackend IO) [Sql]
 -> ReaderT SqlBackend IO ([Sql], CautiousMigration))
-> (Migration
    -> WriterT CautiousMigration (ReaderT SqlBackend IO) [Sql])
-> Migration
-> ReaderT SqlBackend IO ([Sql], CautiousMigration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Migration
-> WriterT CautiousMigration (ReaderT SqlBackend IO) [Sql]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT
  where
    go :: ([a], b) -> Either [a] b
go ([], b
sql) = b -> Either [a] b
forall a b. b -> Either a b
Right b
sql
    go ([a]
errs, b
_) = [a] -> Either [a] b
forall a b. a -> Either a b
Left [a]
errs

    liftIOReader :: ReaderT r IO a -> ReaderT r m a
liftIOReader (ReaderT r -> IO a
m) = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (r -> IO a) -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> IO a
m

-- | Like 'parseMigration', but instead of returning the value in an
-- 'Either' value, it calls 'error' on the error values.
parseMigration' :: (HasCallStack, MonadIO m) => Migration -> ReaderT SqlBackend m (CautiousMigration)
parseMigration' :: Migration -> ReaderT SqlBackend m CautiousMigration
parseMigration' Migration
m = do
  Either [Sql] CautiousMigration
x <- Migration -> ReaderT SqlBackend m (Either [Sql] CautiousMigration)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m (Either [Sql] CautiousMigration)
parseMigration Migration
m
  case Either [Sql] CautiousMigration
x of
      Left [Sql]
errs -> [Char] -> ReaderT SqlBackend m CautiousMigration
forall a. HasCallStack => [Char] -> a
error ([Char] -> ReaderT SqlBackend m CautiousMigration)
-> [Char] -> ReaderT SqlBackend m CautiousMigration
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Sql -> [Char]) -> [Sql] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Sql -> [Char]
unpack [Sql]
errs
      Right CautiousMigration
sql -> CautiousMigration -> ReaderT SqlBackend m CautiousMigration
forall (m :: * -> *) a. Monad m => a -> m a
return CautiousMigration
sql

-- | Prints a migration.
printMigration :: (HasCallStack, MonadIO m) => Migration -> ReaderT SqlBackend m ()
printMigration :: Migration -> ReaderT SqlBackend m ()
printMigration Migration
m = Migration -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m [Sql]
showMigration Migration
m
               ReaderT SqlBackend m [Sql]
-> ([Sql] -> ReaderT SqlBackend m ()) -> ReaderT SqlBackend m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Sql -> ReaderT SqlBackend m ())
-> [Sql] -> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> (Sql -> IO ()) -> Sql -> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sql -> IO ()
Data.Text.IO.putStrLn)

-- | Convert a 'Migration' to a list of 'Text' values corresponding to their
-- 'Sql' statements.
showMigration :: (HasCallStack, MonadIO m) => Migration -> ReaderT SqlBackend m [Text]
showMigration :: Migration -> ReaderT SqlBackend m [Sql]
showMigration Migration
m = (Sql -> Sql) -> [Sql] -> [Sql]
forall a b. (a -> b) -> [a] -> [b]
map ((Sql -> Char -> Sql) -> Char -> Sql -> Sql
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sql -> Char -> Sql
snoc Char
';') ([Sql] -> [Sql])
-> ReaderT SqlBackend m [Sql] -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Migration -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Migration -> ReaderT SqlBackend m [Sql]
getMigration Migration
m

-- | Return all of the 'Sql' values associated with the given migration.
-- Calls 'error' if there's a parse error on any migration.
getMigration :: (MonadIO m, HasCallStack) => Migration -> ReaderT SqlBackend m [Sql]
getMigration :: Migration -> ReaderT SqlBackend m [Sql]
getMigration Migration
m = do
  CautiousMigration
mig <- Migration -> ReaderT SqlBackend m CautiousMigration
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m CautiousMigration
parseMigration' Migration
m
  [Sql] -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Sql] -> ReaderT SqlBackend m [Sql])
-> [Sql] -> ReaderT SqlBackend m [Sql]
forall a b. (a -> b) -> a -> b
$ CautiousMigration -> [Sql]
allSql CautiousMigration
mig

-- | Runs a migration. If the migration fails to parse or if any of the
-- migrations are unsafe, then this throws a 'PersistUnsafeMigrationException'.
runMigration :: MonadIO m

             => Migration
             -> ReaderT SqlBackend m ()
runMigration :: Migration -> ReaderT SqlBackend m ()
runMigration Migration
m = Migration -> Bool -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> Bool -> ReaderT SqlBackend m [Sql]
runMigration' Migration
m Bool
False ReaderT SqlBackend m [Sql]
-> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Same as 'runMigration', but does not report the individual migrations on
-- stderr. Instead it returns a list of the executed SQL commands.
--
-- This is a safer/more robust alternative to 'runMigrationSilent', but may be
-- less silent for some persistent implementations, most notably
-- persistent-postgresql
--
-- @since 2.10.2
runMigrationQuiet :: MonadIO m
                  => Migration
                  -> ReaderT SqlBackend m [Text]
runMigrationQuiet :: Migration -> ReaderT SqlBackend m [Sql]
runMigrationQuiet Migration
m = Migration -> Bool -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> Bool -> ReaderT SqlBackend m [Sql]
runMigration' Migration
m Bool
True

-- | Same as 'runMigration', but returns a list of the SQL commands executed
-- instead of printing them to stderr.
--
-- This function silences the migration by remapping 'stderr'. As a result, it
-- is not thread-safe and can clobber output from other parts of the program.
-- This implementation method was chosen to also silence postgresql migration
-- output on stderr, but is not recommended!
runMigrationSilent :: MonadUnliftIO m
                   => Migration
                   -> ReaderT SqlBackend m [Text]
runMigrationSilent :: Migration -> ReaderT SqlBackend m [Sql]
runMigrationSilent Migration
m = ((forall a. ReaderT SqlBackend m a -> IO a) -> IO [Sql])
-> ReaderT SqlBackend m [Sql]
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT SqlBackend m a -> IO a) -> IO [Sql])
 -> ReaderT SqlBackend m [Sql])
-> ((forall a. ReaderT SqlBackend m a -> IO a) -> IO [Sql])
-> ReaderT SqlBackend m [Sql]
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT SqlBackend m a -> IO a
run ->
  [Handle] -> IO [Sql] -> IO [Sql]
forall a. [Handle] -> IO a -> IO a
hSilence [Handle
stderr] (IO [Sql] -> IO [Sql]) -> IO [Sql] -> IO [Sql]
forall a b. (a -> b) -> a -> b
$ ReaderT SqlBackend m [Sql] -> IO [Sql]
forall a. ReaderT SqlBackend m a -> IO a
run (ReaderT SqlBackend m [Sql] -> IO [Sql])
-> ReaderT SqlBackend m [Sql] -> IO [Sql]
forall a b. (a -> b) -> a -> b
$ Migration -> Bool -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> Bool -> ReaderT SqlBackend m [Sql]
runMigration' Migration
m Bool
True

-- | Run the given migration against the database. If the migration fails
-- to parse, or there are any unsafe migrations, then this will error at
-- runtime. This returns a list of the migrations that were executed.
runMigration'
    :: (HasCallStack, MonadIO m)
    => Migration
    -> Bool -- ^ is silent?
    -> ReaderT SqlBackend m [Text]
runMigration' :: Migration -> Bool -> ReaderT SqlBackend m [Sql]
runMigration' Migration
m Bool
silent = do
    CautiousMigration
mig <- Migration -> ReaderT SqlBackend m CautiousMigration
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m CautiousMigration
parseMigration' Migration
m
    if ((Bool, Sql) -> Bool) -> CautiousMigration -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, Sql) -> Bool
forall a b. (a, b) -> a
fst CautiousMigration
mig
        then IO [Sql] -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Sql] -> ReaderT SqlBackend m [Sql])
-> (PersistUnsafeMigrationException -> IO [Sql])
-> PersistUnsafeMigrationException
-> ReaderT SqlBackend m [Sql]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistUnsafeMigrationException -> IO [Sql]
forall e a. Exception e => e -> IO a
throwIO (PersistUnsafeMigrationException -> ReaderT SqlBackend m [Sql])
-> PersistUnsafeMigrationException -> ReaderT SqlBackend m [Sql]
forall a b. (a -> b) -> a -> b
$ CautiousMigration -> PersistUnsafeMigrationException
PersistUnsafeMigrationException CautiousMigration
mig
        else (Sql -> ReaderT SqlBackend m Sql)
-> [Sql] -> ReaderT SqlBackend m [Sql]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Sql -> ReaderT SqlBackend m Sql
forall (m :: * -> *).
MonadIO m =>
Bool -> Sql -> ReaderT SqlBackend m Sql
executeMigrate Bool
silent) ([Sql] -> ReaderT SqlBackend m [Sql])
-> [Sql] -> ReaderT SqlBackend m [Sql]
forall a b. (a -> b) -> a -> b
$ [Sql] -> [Sql]
sortMigrations ([Sql] -> [Sql]) -> [Sql] -> [Sql]
forall a b. (a -> b) -> a -> b
$ CautiousMigration -> [Sql]
safeSql CautiousMigration
mig

-- | Like 'runMigration', but this will perform the unsafe database
-- migrations instead of erroring out.
runMigrationUnsafe :: MonadIO m
                   => Migration
                   -> ReaderT SqlBackend m ()
runMigrationUnsafe :: Migration -> ReaderT SqlBackend m ()
runMigrationUnsafe Migration
m = Bool -> Migration -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bool -> Migration -> ReaderT SqlBackend m [Sql]
runMigrationUnsafe' Bool
False Migration
m ReaderT SqlBackend m [Sql]
-> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Same as 'runMigrationUnsafe', but returns a list of the SQL commands
-- executed instead of printing them to stderr.
--
-- @since 2.10.2
runMigrationUnsafeQuiet :: (HasCallStack, MonadIO m)
                        => Migration
                        -> ReaderT SqlBackend m [Text]
runMigrationUnsafeQuiet :: Migration -> ReaderT SqlBackend m [Sql]
runMigrationUnsafeQuiet = Bool -> Migration -> ReaderT SqlBackend m [Sql]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bool -> Migration -> ReaderT SqlBackend m [Sql]
runMigrationUnsafe' Bool
True

runMigrationUnsafe' :: (HasCallStack, MonadIO m)
                    => Bool
                    -> Migration
                    -> ReaderT SqlBackend m [Text]
runMigrationUnsafe' :: Bool -> Migration -> ReaderT SqlBackend m [Sql]
runMigrationUnsafe' Bool
silent Migration
m = do
    CautiousMigration
mig <- Migration -> ReaderT SqlBackend m CautiousMigration
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m CautiousMigration
parseMigration' Migration
m
    (Sql -> ReaderT SqlBackend m Sql)
-> [Sql] -> ReaderT SqlBackend m [Sql]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Sql -> ReaderT SqlBackend m Sql
forall (m :: * -> *).
MonadIO m =>
Bool -> Sql -> ReaderT SqlBackend m Sql
executeMigrate Bool
silent) ([Sql] -> ReaderT SqlBackend m [Sql])
-> [Sql] -> ReaderT SqlBackend m [Sql]
forall a b. (a -> b) -> a -> b
$ [Sql] -> [Sql]
sortMigrations ([Sql] -> [Sql]) -> [Sql] -> [Sql]
forall a b. (a -> b) -> a -> b
$ CautiousMigration -> [Sql]
allSql CautiousMigration
mig

executeMigrate :: MonadIO m => Bool -> Text -> ReaderT SqlBackend m Text
executeMigrate :: Bool -> Sql -> ReaderT SqlBackend m Sql
executeMigrate Bool
silent Sql
s = do
    Bool -> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
silent (ReaderT SqlBackend m () -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Migrating: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Sql -> [Char]
unpack Sql
s
    Sql -> [PersistValue] -> ReaderT SqlBackend m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Sql -> [PersistValue] -> ReaderT backend m ()
rawExecute Sql
s []
    Sql -> ReaderT SqlBackend m Sql
forall (m :: * -> *) a. Monad m => a -> m a
return Sql
s

-- | Sort the alter DB statements so tables are created before constraints are
-- added.
sortMigrations :: [Sql] -> [Sql]
sortMigrations :: [Sql] -> [Sql]
sortMigrations [Sql]
x =
    (Sql -> Bool) -> [Sql] -> [Sql]
forall a. (a -> Bool) -> [a] -> [a]
filter Sql -> Bool
isCreate [Sql]
x [Sql] -> [Sql] -> [Sql]
forall a. [a] -> [a] -> [a]
++ (Sql -> Bool) -> [Sql] -> [Sql]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Sql -> Bool) -> Sql -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sql -> Bool
isCreate) [Sql]
x
  where
    -- Note the use of lower-case e. This (hack) allows backends to explicitly
    -- choose to have this special sorting applied.
    isCreate :: Sql -> Bool
isCreate Sql
t = [Char] -> Sql
pack [Char]
"CREATe " Sql -> Sql -> Bool
`isPrefixOf` Sql
t

-- |  Given a list of old entity definitions and a new 'EntityDef' in
-- @val@, this creates a 'Migration' to update the old list of definitions
-- with the new one.
migrate :: [EntityDef]
        -> EntityDef
        -> Migration
migrate :: [EntityDef] -> EntityDef -> Migration
migrate [EntityDef]
allDefs EntityDef
val = do
    SqlBackend
conn <- WriterT CautiousMigration (ReaderT SqlBackend IO) SqlBackend
-> WriterT
     [Sql]
     (WriterT CautiousMigration (ReaderT SqlBackend IO))
     SqlBackend
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT CautiousMigration (ReaderT SqlBackend IO) SqlBackend
 -> WriterT
      [Sql]
      (WriterT CautiousMigration (ReaderT SqlBackend IO))
      SqlBackend)
-> WriterT CautiousMigration (ReaderT SqlBackend IO) SqlBackend
-> WriterT
     [Sql]
     (WriterT CautiousMigration (ReaderT SqlBackend IO))
     SqlBackend
forall a b. (a -> b) -> a -> b
$ ReaderT SqlBackend IO SqlBackend
-> WriterT CautiousMigration (ReaderT SqlBackend IO) SqlBackend
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT SqlBackend IO SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    Either [Sql] CautiousMigration
res <- IO (Either [Sql] CautiousMigration)
-> WriterT
     [Sql]
     (WriterT CautiousMigration (ReaderT SqlBackend IO))
     (Either [Sql] CautiousMigration)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [Sql] CautiousMigration)
 -> WriterT
      [Sql]
      (WriterT CautiousMigration (ReaderT SqlBackend IO))
      (Either [Sql] CautiousMigration))
-> IO (Either [Sql] CautiousMigration)
-> WriterT
     [Sql]
     (WriterT CautiousMigration (ReaderT SqlBackend IO))
     (Either [Sql] CautiousMigration)
forall a b. (a -> b) -> a -> b
$ SqlBackend
-> [EntityDef]
-> (Sql -> IO Statement)
-> EntityDef
-> IO (Either [Sql] CautiousMigration)
connMigrateSql SqlBackend
conn [EntityDef]
allDefs (SqlBackend -> Sql -> IO Statement
getStmtConn SqlBackend
conn) EntityDef
val
    ([Sql] -> Migration)
-> (CautiousMigration -> Migration)
-> Either [Sql] CautiousMigration
-> Migration
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Sql] -> Migration
reportErrors CautiousMigration -> Migration
addMigrations Either [Sql] CautiousMigration
res

-- | Report a single error in a 'Migration'.
--
-- @since 2.9.2
reportError :: Text -> Migration
reportError :: Sql -> Migration
reportError = [Sql] -> Migration
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ([Sql] -> Migration) -> (Sql -> [Sql]) -> Sql -> Migration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sql -> [Sql]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Report multiple errors in a 'Migration'.
--
-- @since 2.9.2
reportErrors :: [Text] -> Migration
reportErrors :: [Sql] -> Migration
reportErrors = [Sql] -> Migration
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell

-- | Add a migration to the migration plan.
--
-- @since 2.9.2
addMigration
    :: Bool
    -- ^ Is the migration safe to run? (eg a non-destructive and idempotent
    -- update on the schema)
    -> Sql
    -- ^ A 'Text' value representing the command to run on the database.
    -> Migration
addMigration :: Bool -> Sql -> Migration
addMigration Bool
isSafe Sql
sql = WriterT CautiousMigration (ReaderT SqlBackend IO) () -> Migration
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CautiousMigration
-> WriterT CautiousMigration (ReaderT SqlBackend IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [(Bool
isSafe, Sql
sql)])

-- | Add a 'CautiousMigration' (aka a @[('Bool', 'Text')]@) to the
-- migration plan.
--
-- @since 2.9.2
addMigrations
    :: CautiousMigration
    -> Migration
addMigrations :: CautiousMigration -> Migration
addMigrations = WriterT CautiousMigration (ReaderT SqlBackend IO) () -> Migration
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT CautiousMigration (ReaderT SqlBackend IO) () -> Migration)
-> (CautiousMigration
    -> WriterT CautiousMigration (ReaderT SqlBackend IO) ())
-> CautiousMigration
-> Migration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CautiousMigration
-> WriterT CautiousMigration (ReaderT SqlBackend IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell

-- | Run an action against the database during a migration. Can be useful for eg
-- creating Postgres extensions:
--
-- @
-- runSqlCommand $ 'rawExecute' "CREATE EXTENSION IF NOT EXISTS \"uuid-ossp\";" []
-- @
--
-- @since 2.13.0.0
runSqlCommand :: SqlPersistT IO () -> Migration
runSqlCommand :: SqlPersistT IO () -> Migration
runSqlCommand = WriterT CautiousMigration (ReaderT SqlBackend IO) () -> Migration
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT CautiousMigration (ReaderT SqlBackend IO) () -> Migration)
-> (SqlPersistT IO ()
    -> WriterT CautiousMigration (ReaderT SqlBackend IO) ())
-> SqlPersistT IO ()
-> Migration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlPersistT IO ()
-> WriterT CautiousMigration (ReaderT SqlBackend IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift