module Database.Persist.Sql.Migration
(
Migration
, CautiousMigration
, Sql
, showMigration
, parseMigration
, parseMigration'
, printMigration
, getMigration
, runMigration
, runMigrationQuiet
, runMigrationSilent
, runMigrationUnsafe
, runMigrationUnsafeQuiet
, migrate
, reportErrors
, reportError
, addMigrations
, addMigration
, runSqlCommand
, PersistUnsafeMigrationException(..)
) 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, isPrefixOf, pack, snoc, unpack)
import qualified Data.Text.IO
import GHC.Stack
import System.IO
import System.IO.Silently (hSilence)
import Database.Persist.Sql.Orphan.PersistStore ()
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Types
import Database.Persist.Sql.Types.Internal
import Database.Persist.Types
import Control.Exception (Exception(..))
type Sql = Text
type CautiousMigration = [(Bool, Sql)]
type Migration = WriterT [Text] (WriterT CautiousMigration (ReaderT SqlBackend IO)) ()
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)
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
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
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)
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
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
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 ()
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
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
runMigration'
:: (HasCallStack, MonadIO m)
=> Migration
-> Bool
-> 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
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 ()
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
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
isCreate :: Sql -> Bool
isCreate Sql
t = [Char] -> Sql
pack [Char]
"CREATe " Sql -> Sql -> Bool
`isPrefixOf` Sql
t
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
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
reportErrors :: [Text] -> Migration
reportErrors :: [Sql] -> Migration
reportErrors = [Sql] -> Migration
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell
addMigration
:: Bool
-> Sql
-> Migration
addMigration :: Bool -> Sql -> Migration
addMigration Bool
isUnsafe 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
isUnsafe, Sql
sql)])
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
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
newtype PersistUnsafeMigrationException
= PersistUnsafeMigrationException [(Bool, Sql)]
instance Show PersistUnsafeMigrationException where
show :: PersistUnsafeMigrationException -> [Char]
show (PersistUnsafeMigrationException CautiousMigration
mig) =
[[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"\n\nDatabase migration: manual intervention required.\n"
, [Char]
"The unsafe actions are prefixed by '***' below:\n\n"
, [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Bool, Sql) -> [Char]) -> CautiousMigration -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Sql) -> [Char]
displayMigration CautiousMigration
mig
]
where
displayMigration :: (Bool, Sql) -> String
displayMigration :: (Bool, Sql) -> [Char]
displayMigration (Bool
True, Sql
s) = [Char]
"*** " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Sql -> [Char]
unpack Sql
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"
displayMigration (Bool
False, Sql
s) = [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Sql -> [Char]
unpack Sql
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"
instance Exception PersistUnsafeMigrationException