module Sq.Migrations {--}
   ( migrate
   , migration
   , Migration
   , MigrationId
   , MigrationsTable
   ) -- }
where

import Control.Exception.Safe qualified as Ex
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource.Extra qualified as R
import Data.Aeson qualified as Ae
import Data.List qualified as List
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String
import Data.Text qualified as T
import Data.Time qualified as Time
import GHC.Records

import Sq.Connection
import Sq.Decoders
import Sq.Encoders
import Sq.Mode
import Sq.Names
import Sq.Pool
import Sq.Statement
import Sq.Transactional

-- | Name of the database table keeping a registry of executed 'Migration's, by
-- their 'MigrationId'.
--
-- * Same syntax rules as 'Name'.
--
-- * This table will be created and updated by 'migrate' as necessary.
newtype MigrationsTable = MigrationsTable Name
   deriving newtype (MigrationsTable -> MigrationsTable -> Bool
(MigrationsTable -> MigrationsTable -> Bool)
-> (MigrationsTable -> MigrationsTable -> Bool)
-> Eq MigrationsTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MigrationsTable -> MigrationsTable -> Bool
== :: MigrationsTable -> MigrationsTable -> Bool
$c/= :: MigrationsTable -> MigrationsTable -> Bool
/= :: MigrationsTable -> MigrationsTable -> Bool
Eq, Eq MigrationsTable
Eq MigrationsTable =>
(MigrationsTable -> MigrationsTable -> Ordering)
-> (MigrationsTable -> MigrationsTable -> Bool)
-> (MigrationsTable -> MigrationsTable -> Bool)
-> (MigrationsTable -> MigrationsTable -> Bool)
-> (MigrationsTable -> MigrationsTable -> Bool)
-> (MigrationsTable -> MigrationsTable -> MigrationsTable)
-> (MigrationsTable -> MigrationsTable -> MigrationsTable)
-> Ord MigrationsTable
MigrationsTable -> MigrationsTable -> Bool
MigrationsTable -> MigrationsTable -> Ordering
MigrationsTable -> MigrationsTable -> MigrationsTable
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MigrationsTable -> MigrationsTable -> Ordering
compare :: MigrationsTable -> MigrationsTable -> Ordering
$c< :: MigrationsTable -> MigrationsTable -> Bool
< :: MigrationsTable -> MigrationsTable -> Bool
$c<= :: MigrationsTable -> MigrationsTable -> Bool
<= :: MigrationsTable -> MigrationsTable -> Bool
$c> :: MigrationsTable -> MigrationsTable -> Bool
> :: MigrationsTable -> MigrationsTable -> Bool
$c>= :: MigrationsTable -> MigrationsTable -> Bool
>= :: MigrationsTable -> MigrationsTable -> Bool
$cmax :: MigrationsTable -> MigrationsTable -> MigrationsTable
max :: MigrationsTable -> MigrationsTable -> MigrationsTable
$cmin :: MigrationsTable -> MigrationsTable -> MigrationsTable
min :: MigrationsTable -> MigrationsTable -> MigrationsTable
Ord, Int -> MigrationsTable -> ShowS
[MigrationsTable] -> ShowS
MigrationsTable -> String
(Int -> MigrationsTable -> ShowS)
-> (MigrationsTable -> String)
-> ([MigrationsTable] -> ShowS)
-> Show MigrationsTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MigrationsTable -> ShowS
showsPrec :: Int -> MigrationsTable -> ShowS
$cshow :: MigrationsTable -> String
show :: MigrationsTable -> String
$cshowList :: [MigrationsTable] -> ShowS
showList :: [MigrationsTable] -> ShowS
Show, String -> MigrationsTable
(String -> MigrationsTable) -> IsString MigrationsTable
forall a. (String -> a) -> IsString a
$cfromString :: String -> MigrationsTable
fromString :: String -> MigrationsTable
IsString, Maybe MigrationsTable
Value -> Parser [MigrationsTable]
Value -> Parser MigrationsTable
(Value -> Parser MigrationsTable)
-> (Value -> Parser [MigrationsTable])
-> Maybe MigrationsTable
-> FromJSON MigrationsTable
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser MigrationsTable
parseJSON :: Value -> Parser MigrationsTable
$cparseJSONList :: Value -> Parser [MigrationsTable]
parseJSONList :: Value -> Parser [MigrationsTable]
$comittedField :: Maybe MigrationsTable
omittedField :: Maybe MigrationsTable
Ae.FromJSON, [MigrationsTable] -> Value
[MigrationsTable] -> Encoding
MigrationsTable -> Bool
MigrationsTable -> Value
MigrationsTable -> Encoding
(MigrationsTable -> Value)
-> (MigrationsTable -> Encoding)
-> ([MigrationsTable] -> Value)
-> ([MigrationsTable] -> Encoding)
-> (MigrationsTable -> Bool)
-> ToJSON MigrationsTable
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: MigrationsTable -> Value
toJSON :: MigrationsTable -> Value
$ctoEncoding :: MigrationsTable -> Encoding
toEncoding :: MigrationsTable -> Encoding
$ctoJSONList :: [MigrationsTable] -> Value
toJSONList :: [MigrationsTable] -> Value
$ctoEncodingList :: [MigrationsTable] -> Encoding
toEncodingList :: [MigrationsTable] -> Encoding
$comitField :: MigrationsTable -> Bool
omitField :: MigrationsTable -> Bool
Ae.ToJSON)

instance HasField "text" MigrationsTable T.Text where
   getField :: MigrationsTable -> Text
getField (MigrationsTable Name
x) = Name
x.text

-- | A single 'Migration' consisting of a 'Transactional' action uniquely
-- identified by a 'MigrationId'.
--
-- * Construct with 'migration'.
--
-- * Run through 'migrate'.
data Migration = Migration MigrationId (Transaction 'Write -> IO ())

instance HasField "id" Migration MigrationId where
   getField :: Migration -> MigrationId
getField (Migration MigrationId
x Transaction 'Write -> IO ()
_) = MigrationId
x

-- | 'Just' if at least one 'MigrationId' is duplicate.
duplicateMigrationId :: [Migration] -> Maybe MigrationId
duplicateMigrationId :: [Migration] -> Maybe MigrationId
duplicateMigrationId = Set MigrationId -> [Migration] -> Maybe MigrationId
go Set MigrationId
forall a. Monoid a => a
mempty
  where
   go :: Set MigrationId -> [Migration] -> Maybe MigrationId
   go :: Set MigrationId -> [Migration] -> Maybe MigrationId
go !Set MigrationId
mIds = \case
      Migration MigrationId
mId Transaction 'Write -> IO ()
_ : [Migration]
ms
         | MigrationId -> Set MigrationId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member MigrationId
mId Set MigrationId
mIds -> MigrationId -> Maybe MigrationId
forall a. a -> Maybe a
Just MigrationId
mId
         | Bool
otherwise -> Set MigrationId -> [Migration] -> Maybe MigrationId
go (MigrationId -> Set MigrationId -> Set MigrationId
forall a. Ord a => a -> Set a -> Set a
Set.insert MigrationId
mId Set MigrationId
mIds) [Migration]
ms
      [] -> Maybe MigrationId
forall a. Maybe a
Nothing

-- | Define a single 'Migration' that, when executed, will perform
-- the given 'Transactional'.
--
-- * See 'Migration'.
migration
   :: MigrationId
   -> (forall g. Transactional g 'NoRetry 'Write ())
   -- ^ Notice the 'NoRetry'. In other words, this 'Transactional'
   -- can't perform 'retry' nor any 'Control.Applicative.Alternative'
   -- nor 'MonadPlus' features.
   -> Migration
migration :: forall {k}.
MigrationId
-> (forall (g :: k). Transactional g 'NoRetry 'Write ())
-> Migration
migration MigrationId
mId forall (g :: k). Transactional g 'NoRetry 'Write ()
ta = MigrationId -> (Transaction 'Write -> IO ()) -> Migration
Migration MigrationId
mId \Transaction 'Write
tx -> Transaction 'Write
-> (forall (g :: k). Transactional g 'NoRetry 'Write ()) -> IO ()
forall {k} (m :: * -> *) (t :: Mode) a.
MonadIO m =>
Transaction t
-> (forall (g :: k). Transactional g 'NoRetry t a) -> m a
embed Transaction 'Write
tx Transactional g 'NoRetry 'Write ()
forall (g :: k). Transactional g 'NoRetry 'Write ()
ta

-- | Unique identifier for a 'Migration' within a 'MigrationsTable'.
--
-- * You are supposed to type these statically, so construct a 'MigrationId'
-- by typing down the literal string.
newtype MigrationId = MigrationId T.Text
   deriving newtype (MigrationId -> MigrationId -> Bool
(MigrationId -> MigrationId -> Bool)
-> (MigrationId -> MigrationId -> Bool) -> Eq MigrationId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MigrationId -> MigrationId -> Bool
== :: MigrationId -> MigrationId -> Bool
$c/= :: MigrationId -> MigrationId -> Bool
/= :: MigrationId -> MigrationId -> Bool
Eq, Eq MigrationId
Eq MigrationId =>
(MigrationId -> MigrationId -> Ordering)
-> (MigrationId -> MigrationId -> Bool)
-> (MigrationId -> MigrationId -> Bool)
-> (MigrationId -> MigrationId -> Bool)
-> (MigrationId -> MigrationId -> Bool)
-> (MigrationId -> MigrationId -> MigrationId)
-> (MigrationId -> MigrationId -> MigrationId)
-> Ord MigrationId
MigrationId -> MigrationId -> Bool
MigrationId -> MigrationId -> Ordering
MigrationId -> MigrationId -> MigrationId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MigrationId -> MigrationId -> Ordering
compare :: MigrationId -> MigrationId -> Ordering
$c< :: MigrationId -> MigrationId -> Bool
< :: MigrationId -> MigrationId -> Bool
$c<= :: MigrationId -> MigrationId -> Bool
<= :: MigrationId -> MigrationId -> Bool
$c> :: MigrationId -> MigrationId -> Bool
> :: MigrationId -> MigrationId -> Bool
$c>= :: MigrationId -> MigrationId -> Bool
>= :: MigrationId -> MigrationId -> Bool
$cmax :: MigrationId -> MigrationId -> MigrationId
max :: MigrationId -> MigrationId -> MigrationId
$cmin :: MigrationId -> MigrationId -> MigrationId
min :: MigrationId -> MigrationId -> MigrationId
Ord, String -> MigrationId
(String -> MigrationId) -> IsString MigrationId
forall a. (String -> a) -> IsString a
$cfromString :: String -> MigrationId
fromString :: String -> MigrationId
IsString, Int -> MigrationId -> ShowS
[MigrationId] -> ShowS
MigrationId -> String
(Int -> MigrationId -> ShowS)
-> (MigrationId -> String)
-> ([MigrationId] -> ShowS)
-> Show MigrationId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MigrationId -> ShowS
showsPrec :: Int -> MigrationId -> ShowS
$cshow :: MigrationId -> String
show :: MigrationId -> String
$cshowList :: [MigrationId] -> ShowS
showList :: [MigrationId] -> ShowS
Show, HasCallStack => Encode MigrationId
(HasCallStack => Encode MigrationId) -> EncodeDefault MigrationId
forall a. (HasCallStack => Encode a) -> EncodeDefault a
$cencodeDefault :: HasCallStack => Encode MigrationId
encodeDefault :: HasCallStack => Encode MigrationId
EncodeDefault, Decode MigrationId
Decode MigrationId -> DecodeDefault MigrationId
forall a. Decode a -> DecodeDefault a
$cdecodeDefault :: Decode MigrationId
decodeDefault :: Decode MigrationId
DecodeDefault)

instance HasField "text" MigrationId T.Text where
   getField :: MigrationId -> Text
getField (MigrationId Text
x) = Text
x

--------------------------------------------------------------------------------

createMigrationsTable :: MigrationsTable -> Statement 'Write () ()
createMigrationsTable :: MigrationsTable -> Statement 'Write () ()
createMigrationsTable MigrationsTable
tbl =
   -- We are storing the timestamp in case we need it in the future.
   -- We aren't really using it now.
   Input () -> Output () -> SQL -> Statement 'Write () ()
forall i o. Input i -> Output o -> SQL -> Statement 'Write i o
writeStatement Input ()
forall a. Monoid a => a
mempty Output ()
forall a. Monoid a => a
mempty (SQL -> Statement 'Write () ()) -> SQL -> Statement 'Write () ()
forall a b. (a -> b) -> a -> b
$
      String -> SQL
forall a. IsString a => String -> a
fromString (String -> SQL) -> String -> SQL
forall a b. (a -> b) -> a -> b
$
         String
"CREATE TABLE IF NOT EXISTS "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MigrationsTable -> String
forall a. Show a => a -> String
show MigrationsTable
tbl
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (ord INTEGER PRIMARY KEY NOT NULL CHECK (ord >= 0)"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", id TEXT UNIQUE NOT NULL"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", time TEXT NOT NULL)"

getMigrations
   :: MigrationsTable -> Statement 'Read () (Time.UTCTime, MigrationId)
getMigrations :: MigrationsTable -> Statement 'Read () (UTCTime, MigrationId)
getMigrations MigrationsTable
tbl =
   Input ()
-> Output (UTCTime, MigrationId)
-> SQL
-> Statement 'Read () (UTCTime, MigrationId)
forall i o. Input i -> Output o -> SQL -> Statement 'Read i o
readStatement Input ()
forall a. Monoid a => a
mempty ((UTCTime -> MigrationId -> (UTCTime, MigrationId))
-> Output UTCTime
-> Output MigrationId
-> Output (UTCTime, MigrationId)
forall a b c. (a -> b -> c) -> Output a -> Output b -> Output c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Output UTCTime
"time" Output MigrationId
"id") (SQL -> Statement 'Read () (UTCTime, MigrationId))
-> SQL -> Statement 'Read () (UTCTime, MigrationId)
forall a b. (a -> b) -> a -> b
$
      String -> SQL
forall a. IsString a => String -> a
fromString (String -> SQL) -> String -> SQL
forall a b. (a -> b) -> a -> b
$
         String
"SELECT time, id FROM " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MigrationsTable -> String
forall a. Show a => a -> String
show MigrationsTable
tbl String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ORDER BY ord ASC"

pushMigration :: MigrationsTable -> Statement 'Write MigrationId Time.UTCTime
pushMigration :: MigrationsTable -> Statement 'Write MigrationId UTCTime
pushMigration MigrationsTable
tbl =
   Input MigrationId
-> Output UTCTime -> SQL -> Statement 'Write MigrationId UTCTime
forall i o. Input i -> Output o -> SQL -> Statement 'Write i o
writeStatement Input MigrationId
"id" Output UTCTime
"time" (SQL -> Statement 'Write MigrationId UTCTime)
-> SQL -> Statement 'Write MigrationId UTCTime
forall a b. (a -> b) -> a -> b
$
      String -> SQL
forall a. IsString a => String -> a
fromString (String -> SQL) -> String -> SQL
forall a b. (a -> b) -> a -> b
$
         String
"INSERT INTO "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MigrationsTable -> String
forall a. Show a => a -> String
show MigrationsTable
tbl
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (ord, time, id)"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" SELECT t.ord"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", strftime('%Y-%m-%dT%H:%M:%f+00:00', 'now', 'subsecond')"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", $id"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" FROM (SELECT coalesce(max(ord) + 1, 0) AS ord FROM "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MigrationsTable -> String
forall a. Show a => a -> String
show MigrationsTable
tbl
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") AS t"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" RETURNING time"

--------------------------------------------------------------------------------

-- | Run all the migrations in 'Migration's that haven't been run yet.
--
-- * If the 'MigrationId's are not compatible with the current migration
-- history as reported by 'MigrationsTable', there will be an exception.
--
-- * If 'MigrationsTable' doesn't exist, it will be created.
--
-- * All the changes are run in a single 'Transaction', including those to
-- 'MigrationsTable'.
migrate
   :: forall a m
    . (MonadIO m, Ex.MonadMask m)
   => Pool 'Write
   -- ^ Connection 'Pool' to the database to migrate.
   -> MigrationsTable
   -- ^ Name of the table where the registry of ran 'Migration's is kept.
   -> [Migration]
   -- ^ 'Migration's to apply to the database, if necessary, in chronological
   -- order.
   -> ([MigrationId] -> m a)
   -- ^ This will be performed __while the write transaction is active__,
   -- letting you know which 'MigrationId's are to be performed, and in which
   -- order.
   --
   -- This can be a good place to perform a backup of the database if
   -- necessary. Presumably, 'migrate' is being run during the initialization
   -- of your program, suggesting that nobody else is trying to write to the
   -- database at this time, so it's OK if this code takes a while to run.
   --
   -- Don't try to acquire a 'Write' transaction here, it will deadlock.
   -- It's OK to interact with the 'Pool' through 'Read'-only means.
   -> m a
migrate :: forall a (m :: * -> *).
(MonadIO m, MonadMask m) =>
Pool 'Write
-> MigrationsTable -> [Migration] -> ([MigrationId] -> m a) -> m a
migrate Pool 'Write
p MigrationsTable
tbl [Migration]
want [MigrationId] -> m a
k
   | Just MigrationId
mId <- [Migration] -> Maybe MigrationId
duplicateMigrationId [Migration]
want =
      String -> m a
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
Ex.throwString (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Duplicate migration id: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MigrationId -> String
forall a. Show a => a -> String
show MigrationId
mId
   | Bool
otherwise = Acquire (Transaction 'Write) -> (Transaction 'Write -> m a) -> m a
forall (m :: * -> *) a b.
(MonadMask m, MonadIO m) =>
Acquire a -> (a -> m b) -> m b
R.withAcquire (Pool 'Write -> Acquire (Transaction 'Write)
commitTransaction Pool 'Write
p) \Transaction 'Write
tx -> do
      [Migration]
pending <- Transaction 'Write
-> (forall (g :: Any). Transactional g 'NoRetry 'Write [Migration])
-> m [Migration]
forall {k} (m :: * -> *) (t :: Mode) a.
MonadIO m =>
Transaction t
-> (forall (g :: k). Transactional g 'NoRetry t a) -> m a
embed Transaction 'Write
tx do
         Statement 'Write () () -> () -> Transactional g 'NoRetry 'Write ()
forall {k} o i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t ()
zero (MigrationsTable -> Statement 'Write () ()
createMigrationsTable MigrationsTable
tbl) ()
         (Int64
nran, [(UTCTime, MigrationId)]
ran) <- Statement 'Read () (UTCTime, MigrationId)
-> ()
-> Transactional
     g 'NoRetry 'Write (Int64, [(UTCTime, MigrationId)])
forall {k} o i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t (Int64, [o])
list (MigrationsTable -> Statement 'Read () (UTCTime, MigrationId)
getMigrations MigrationsTable
tbl) ()
         case [MigrationId] -> [MigrationId] -> Maybe [MigrationId]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix (((UTCTime, MigrationId) -> MigrationId)
-> [(UTCTime, MigrationId)] -> [MigrationId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UTCTime, MigrationId) -> MigrationId
forall a b. (a, b) -> b
snd [(UTCTime, MigrationId)]
ran) ((Migration -> MigrationId) -> [Migration] -> [MigrationId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.id) [Migration]
want) of
            Just [MigrationId]
_ -> [Migration] -> Transactional g 'NoRetry 'Write [Migration]
forall a. a -> Transactional g 'NoRetry 'Write a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Migration] -> Transactional g 'NoRetry 'Write [Migration])
-> [Migration] -> Transactional g 'NoRetry 'Write [Migration]
forall a b. (a -> b) -> a -> b
$ Int -> [Migration] -> [Migration]
forall a. Int -> [a] -> [a]
List.drop (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nran) [Migration]
want
            Maybe [MigrationId]
Nothing ->
               String -> Transactional g 'NoRetry 'Write [Migration]
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
Ex.throwString (String -> Transactional g 'NoRetry 'Write [Migration])
-> String -> Transactional g 'NoRetry 'Write [Migration]
forall a b. (a -> b) -> a -> b
$
                  String
"Incompatible migration history: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [MigrationId] -> String
forall a. Show a => a -> String
show (((UTCTime, MigrationId) -> MigrationId)
-> [(UTCTime, MigrationId)] -> [MigrationId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UTCTime, MigrationId) -> MigrationId
forall a b. (a, b) -> b
snd [(UTCTime, MigrationId)]
ran)
      a
a <- [MigrationId] -> m a
k ([MigrationId] -> m a) -> [MigrationId] -> m a
forall a b. (a -> b) -> a -> b
$ (Migration -> MigrationId) -> [Migration] -> [MigrationId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.id) [Migration]
pending
      [Migration] -> (Migration -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Migration]
pending \(Migration MigrationId
mId Transaction 'Write -> IO ()
f) -> do
         IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Transaction 'Write -> IO ()
f Transaction 'Write
tx
         m UTCTime -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UTCTime -> m ()) -> m UTCTime -> m ()
forall a b. (a -> b) -> a -> b
$ Transaction 'Write
-> (forall {g :: Any}. Transactional g 'NoRetry 'Write UTCTime)
-> m UTCTime
forall {k} (m :: * -> *) (t :: Mode) a.
MonadIO m =>
Transaction t
-> (forall (g :: k). Transactional g 'NoRetry t a) -> m a
embed Transaction 'Write
tx ((forall {g :: Any}. Transactional g 'NoRetry 'Write UTCTime)
 -> m UTCTime)
-> (forall {g :: Any}. Transactional g 'NoRetry 'Write UTCTime)
-> m UTCTime
forall a b. (a -> b) -> a -> b
$ Statement 'Write MigrationId UTCTime
-> MigrationId -> Transactional g 'NoRetry 'Write UTCTime
forall {k} o i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t o
one (MigrationsTable -> Statement 'Write MigrationId UTCTime
pushMigration MigrationsTable
tbl) MigrationId
mId
      a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a