{-# LANGUAGE Arrows #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
-- |Module containing definition of and functions for maintaining the in-database state storage for Refurb.
module Refurb.Store where

import ClassyPrelude
import Composite.Opaleye (defaultRecTable)
import Composite.Opaleye.TH (deriveOpaleyeEnum)
import Composite.Record ((:->), Record)
import Composite.TH (withLensesAndProxies)
import Control.Arrow (returnA)
import Control.Lens (view)
import Control.Monad.Base (liftBase)
import Control.Monad.Catch (MonadMask)
import Control.Monad.Logger (MonadLogger, logDebug)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.These (These(This, These, That))
import qualified Database.PostgreSQL.Simple as PG
import Opaleye (Field, SelectArr, SqlBool, SqlInt4, SqlFloat8, SqlText, SqlTimestamptz, Table, asc, orderBy, runSelect, selectTable, tableWithSchema)
import Refurb.MigrationUtils (doesTableExist, qqSqls)
import Refurb.Types (Migration, migrationQualifiedKey)

-- |Result of running a migration, either success or failure.
data MigrationResult
  = MigrationSuccess
  | MigrationFailure
  deriving (MigrationResult -> MigrationResult -> Bool
(MigrationResult -> MigrationResult -> Bool)
-> (MigrationResult -> MigrationResult -> Bool)
-> Eq MigrationResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrationResult -> MigrationResult -> Bool
$c/= :: MigrationResult -> MigrationResult -> Bool
== :: MigrationResult -> MigrationResult -> Bool
$c== :: MigrationResult -> MigrationResult -> Bool
Eq, Int -> MigrationResult -> ShowS
[MigrationResult] -> ShowS
MigrationResult -> String
(Int -> MigrationResult -> ShowS)
-> (MigrationResult -> String)
-> ([MigrationResult] -> ShowS)
-> Show MigrationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrationResult] -> ShowS
$cshowList :: [MigrationResult] -> ShowS
show :: MigrationResult -> String
$cshow :: MigrationResult -> String
showsPrec :: Int -> MigrationResult -> ShowS
$cshowsPrec :: Int -> MigrationResult -> ShowS
Show)

deriveOpaleyeEnum ''MigrationResult "refurb.migration_result_enum" (stripPrefix "migration" . toLower)

withLensesAndProxies [d|
  type FId           = "id"            :-> Int32
  type FIdMay        = "id"            :-> Maybe Int32
  type CId           = "id"            :-> Field SqlInt4
  type CIdMay        = "id"            :-> Maybe (Field SqlInt4)
  type FQualifiedKey = "qualified_key" :-> Text
  type CQualifiedKey = "qualified_key" :-> Field SqlText
  type FApplied      = "applied"       :-> UTCTime
  type CApplied      = "applied"       :-> Field SqlTimestamptz
  type FOutput       = "output"        :-> Text
  type COutput       = "output"        :-> Field SqlText
  type FResult       = "result"        :-> MigrationResult
  type CResult       = "result"        :-> Field PGMigrationResult
  type FDuration     = "duration"      :-> Double
  type CDuration     = "duration"      :-> Field SqlFloat8

  type FProdSystem = "prod_system" :-> Bool
  type CProdSystem = "prod_system" :-> Field SqlBool
  |]

-- |Fields of a migration log entry in memory fetched from the database (with ID)
type MigrationLog      = '[FId   , FQualifiedKey, FApplied, FOutput, FResult, FDuration]
-- |Fields of a migration log entry to insert in the database (with the ID column optional)
type MigrationLogW     = '[FIdMay, FQualifiedKey, FApplied, FOutput, FResult, FDuration]
-- |Columns of a migration log when reading from the database (with ID)
type MigrationLogColsR = '[CId   , CQualifiedKey, CApplied, COutput, CResult, CDuration]
-- |Columns of a migration log when inserting into the database (with ID column optional)
type MigrationLogColsW = '[CIdMay, CQualifiedKey, CApplied, COutput, CResult, CDuration]

-- |Fields of the Refurb config in memory
type RefurbConfig     = '[FProdSystem]
-- |Columns of the Refurb config in the database
type RefurbConfigCols = '[CProdSystem]

-- |The migration log table which records all executed migrations and their results
migrationLog :: Table (Record MigrationLogColsW) (Record MigrationLogColsR)
migrationLog :: Table (Record MigrationLogColsW) (Record MigrationLogColsR)
migrationLog = String
-> String
-> TableFields
     (Record MigrationLogColsW) (Record MigrationLogColsR)
-> Table (Record MigrationLogColsW) (Record MigrationLogColsR)
forall writeFields viewFields.
String
-> String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
tableWithSchema String
"refurb" String
"migration_log" TableFields (Record MigrationLogColsW) (Record MigrationLogColsR)
forall (write :: [*]) (read :: [*]).
DefaultRecTable write read =>
TableFields (Rec Identity write) (Rec Identity read)
defaultRecTable

-- |The refurb config table which controls whether this database is considered a production one or not
refurbConfig :: Table (Record RefurbConfigCols) (Record RefurbConfigCols)
refurbConfig :: Table (Record RefurbConfigCols) (Record RefurbConfigCols)
refurbConfig = String
-> String
-> TableFields (Record RefurbConfigCols) (Record RefurbConfigCols)
-> Table (Record RefurbConfigCols) (Record RefurbConfigCols)
forall writeFields viewFields.
String
-> String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
tableWithSchema String
"refurb" String
"config" TableFields (Record RefurbConfigCols) (Record RefurbConfigCols)
forall (write :: [*]) (read :: [*]).
DefaultRecTable write read =>
TableFields (Rec Identity write) (Rec Identity read)
defaultRecTable

-- |Test to see if the schema seems to be installed by looking for an existing refurb_config table
isSchemaPresent :: (MonadBaseControl IO m, MonadMask m, MonadLogger m) => PG.Connection -> m Bool
isSchemaPresent :: Connection -> m Bool
isSchemaPresent Connection
conn = do
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug Text
"Checking if schema present"
  ReaderT Connection m Bool -> Connection -> m Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Text -> Text -> ReaderT Connection m Bool
forall (m :: * -> *). MonadMigration m => Text -> Text -> m Bool
doesTableExist Text
"refurb" Text
"config") Connection
conn

-- |Check if this database is configured as a production database by reading the refurb config table
isProdSystem :: (MonadBaseControl IO m, MonadLogger m) => PG.Connection -> m Bool
isProdSystem :: Connection -> m Bool
isProdSystem Connection
conn = do
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug Text
"Checking if this is a prod system"
  ([Bool] -> Bool) -> m [Bool] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> ([Bool] -> Maybe Bool) -> [Bool] -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Bool] -> Maybe Bool
forall mono. MonoFoldable mono => mono -> Maybe (Element mono)
headMay) (m [Bool] -> m Bool)
-> (Select (Field SqlBool) -> m [Bool])
-> Select (Field SqlBool)
-> m Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO [Bool] -> m [Bool]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [Bool] -> m [Bool])
-> (Select (Field SqlBool) -> IO [Bool])
-> Select (Field SqlBool)
-> m [Bool]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Connection -> Select (Field SqlBool) -> IO [Bool]
forall fields haskells.
Default FromFields fields haskells =>
Connection -> Select fields -> IO [haskells]
runSelect Connection
conn (Select (Field SqlBool) -> m Bool)
-> Select (Field SqlBool) -> m Bool
forall a b. (a -> b) -> a -> b
$ proc () -> do
    Record RefurbConfigCols
config <- Table (Record RefurbConfigCols) (Record RefurbConfigCols)
-> Select (Record RefurbConfigCols)
forall fields a.
Default Unpackspec fields fields =>
Table a fields -> Select fields
selectTable Table (Record RefurbConfigCols) (Record RefurbConfigCols)
refurbConfig -< ()
    SelectArr (Field SqlBool) (Field SqlBool)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Getting (Field SqlBool) (Record RefurbConfigCols) (Field SqlBool)
-> Record RefurbConfigCols -> Field SqlBool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Field SqlBool) (Record RefurbConfigCols) (Field SqlBool)
forall (f :: * -> *) (rs :: [*]).
(Functor f, CProdSystem ∈ rs) =>
(Field SqlBool -> f (Field SqlBool)) -> Record rs -> f (Record rs)
cProdSystem Record RefurbConfigCols
config

-- |Create the refurb schema elements. Will fail if they already exist.
initializeSchema :: (MonadBaseControl IO m, MonadLogger m) => PG.Connection -> m ()
initializeSchema :: Connection -> m ()
initializeSchema Connection
conn = do
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug Text
"Initializing refurb schema"

  IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (Element [Query] -> IO ()) -> [Query] -> IO ()
forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
(Element mono -> f b) -> mono -> f ()
traverse_ (IO Int64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int64 -> IO ()) -> (Query -> IO Int64) -> Query -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Connection -> Query -> IO Int64
PG.execute_ Connection
conn) [qqSqls|
    create schema refurb;
    set search_path = 'refurb';
    create type migration_result_enum as enum('success', 'failure');
    create table config (prod_system boolean not null);
    insert into config (prod_system) values (false);
    create sequence migration_log_serial;
    create table migration_log
      ( id            int                   not null
                                            primary key
                                            default nextval('migration_log_serial')
      , qualified_key text                  not null
                                            unique
      , applied       timestamptz           not null
      , output        text                  not null
      , result        migration_result_enum not null
      , duration      double precision      not null
      );
    |]

-- |Read the migration log and stitch it together with the expected migration list, forming a list in the same order as the known migrations but with
-- 'These' representing whether the migration log for the known migration is present or not.
--
-- * @'This' migration@ represents a known migration that has no log entry.
-- * @'That' migrationLog@ represents an unknown migration that was applied in the past.
-- * @'These' migration migrationLog@ represents a migration that has an attempted application in the log.
readMigrationStatus
  :: (MonadBaseControl IO m, MonadLogger m)
  => PG.Connection
  -> [Migration]
  -> SelectArr (Record MigrationLogColsR) ()
  -> m [These Migration (Record MigrationLog)]
readMigrationStatus :: Connection
-> [Migration]
-> SelectArr (Record MigrationLogColsR) ()
-> m [These Migration (Record MigrationLog)]
readMigrationStatus Connection
conn [Migration]
migrations SelectArr (Record MigrationLogColsR) ()
restriction = do
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug Text
"Reading migration status"
  [Record MigrationLog]
migrationStatus <- IO [Record MigrationLog] -> m [Record MigrationLog]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [Record MigrationLog] -> m [Record MigrationLog])
-> IO [Record MigrationLog] -> m [Record MigrationLog]
forall a b. (a -> b) -> a -> b
$ Connection
-> Select (Record MigrationLogColsR) -> IO [Record MigrationLog]
forall fields haskells.
Default FromFields fields haskells =>
Connection -> Select fields -> IO [haskells]
runSelect Connection
conn (Select (Record MigrationLogColsR) -> IO [Record MigrationLog])
-> (Select (Record MigrationLogColsR)
    -> Select (Record MigrationLogColsR))
-> Select (Record MigrationLogColsR)
-> IO [Record MigrationLog]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Order (Record MigrationLogColsR)
-> Select (Record MigrationLogColsR)
-> Select (Record MigrationLogColsR)
forall a. Order a -> Select a -> Select a
orderBy ((Record MigrationLogColsR -> Field SqlText)
-> Order (Record MigrationLogColsR)
forall b a. SqlOrd b => (a -> Field b) -> Order a
asc ((Record MigrationLogColsR -> Field SqlText)
 -> Order (Record MigrationLogColsR))
-> (Record MigrationLogColsR -> Field SqlText)
-> Order (Record MigrationLogColsR)
forall a b. (a -> b) -> a -> b
$ Getting (Field SqlText) (Record MigrationLogColsR) (Field SqlText)
-> Record MigrationLogColsR -> Field SqlText
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Field SqlText) (Record MigrationLogColsR) (Field SqlText)
forall (f :: * -> *) (rs :: [*]).
(Functor f, CQualifiedKey ∈ rs) =>
(Field SqlText -> f (Field SqlText)) -> Record rs -> f (Record rs)
cQualifiedKey) (Select (Record MigrationLogColsR) -> IO [Record MigrationLog])
-> Select (Record MigrationLogColsR) -> IO [Record MigrationLog]
forall a b. (a -> b) -> a -> b
$ proc () -> do
    Record MigrationLogColsR
mlog <- Table (Record MigrationLogColsW) (Record MigrationLogColsR)
-> Select (Record MigrationLogColsR)
forall fields a.
Default Unpackspec fields fields =>
Table a fields -> Select fields
selectTable Table (Record MigrationLogColsW) (Record MigrationLogColsR)
migrationLog -< ()
    SelectArr (Record MigrationLogColsR) ()
restriction -< Record MigrationLogColsR
mlog
    SelectArr (Record MigrationLogColsR) (Record MigrationLogColsR)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Record MigrationLogColsR
mlog

  let migrationLogByKey :: Map Text (Record MigrationLog)
migrationLogByKey = [(ContainerKey (Map Text (Record MigrationLog)),
  MapValue (Map Text (Record MigrationLog)))]
-> Map Text (Record MigrationLog)
forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
mapFromList ([(ContainerKey (Map Text (Record MigrationLog)),
   MapValue (Map Text (Record MigrationLog)))]
 -> Map Text (Record MigrationLog))
-> ([Record MigrationLog]
    -> [(ContainerKey (Map Text (Record MigrationLog)),
         MapValue (Map Text (Record MigrationLog)))])
-> [Record MigrationLog]
-> Map Text (Record MigrationLog)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Record MigrationLog -> (Text, Record MigrationLog))
-> [Record MigrationLog] -> [(Text, Record MigrationLog)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Getting Text (Record MigrationLog) Text
-> Record MigrationLog -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (Record MigrationLog) Text
forall (f :: * -> *) (rs :: [*]).
(Functor f, FQualifiedKey ∈ rs) =>
(Text -> f Text) -> Record rs -> f (Record rs)
fQualifiedKey (Record MigrationLog -> Text)
-> (Record MigrationLog -> Record MigrationLog)
-> Record MigrationLog
-> (Text, Record MigrationLog)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Record MigrationLog -> Record MigrationLog
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) ([Record MigrationLog] -> Map Text (Record MigrationLog))
-> [Record MigrationLog] -> Map Text (Record MigrationLog)
forall a b. (a -> b) -> a -> b
$ [Record MigrationLog]
migrationStatus

      alignMigration
        :: Migration
        -> ([These Migration (Record MigrationLog)], Map Text (Record MigrationLog))
        -> ([These Migration (Record MigrationLog)], Map Text (Record MigrationLog))
      alignMigration :: Migration
-> ([These Migration (Record MigrationLog)],
    Map Text (Record MigrationLog))
-> ([These Migration (Record MigrationLog)],
    Map Text (Record MigrationLog))
alignMigration m :: Migration
m@(Migration -> Text
migrationQualifiedKey -> Text
k) ([These Migration (Record MigrationLog)]
t, Map Text (Record MigrationLog)
l) =
        (Maybe (Record MigrationLog)
 -> [These Migration (Record MigrationLog)])
-> (Maybe (Record MigrationLog), Map Text (Record MigrationLog))
-> ([These Migration (Record MigrationLog)],
    Map Text (Record MigrationLog))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((These Migration (Record MigrationLog)
-> [These Migration (Record MigrationLog)]
-> [These Migration (Record MigrationLog)]
forall a. a -> [a] -> [a]
:[These Migration (Record MigrationLog)]
t) (These Migration (Record MigrationLog)
 -> [These Migration (Record MigrationLog)])
-> (Maybe (Record MigrationLog)
    -> These Migration (Record MigrationLog))
-> Maybe (Record MigrationLog)
-> [These Migration (Record MigrationLog)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. These Migration (Record MigrationLog)
-> (Record MigrationLog -> These Migration (Record MigrationLog))
-> Maybe (Record MigrationLog)
-> These Migration (Record MigrationLog)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Migration -> These Migration (Record MigrationLog)
forall a b. a -> These a b
This Migration
m) (Migration
-> Record MigrationLog -> These Migration (Record MigrationLog)
forall a b. a -> b -> These a b
These Migration
m)) ((ContainerKey (Map Text (Record MigrationLog))
 -> MapValue (Map Text (Record MigrationLog))
 -> Maybe (MapValue (Map Text (Record MigrationLog))))
-> ContainerKey (Map Text (Record MigrationLog))
-> Map Text (Record MigrationLog)
-> (Maybe (MapValue (Map Text (Record MigrationLog))),
    Map Text (Record MigrationLog))
forall map.
IsMap map =>
(ContainerKey map -> MapValue map -> Maybe (MapValue map))
-> ContainerKey map -> map -> (Maybe (MapValue map), map)
updateLookupWithKey (\ ContainerKey (Map Text (Record MigrationLog))
_ MapValue (Map Text (Record MigrationLog))
_ -> Maybe (MapValue (Map Text (Record MigrationLog)))
forall a. Maybe a
Nothing) Text
ContainerKey (Map Text (Record MigrationLog))
k Map Text (Record MigrationLog)
l)

      ([These Migration (Record MigrationLog)]
aligned, Map Text (Record MigrationLog)
extra) = (Element [Migration]
 -> ([These Migration (Record MigrationLog)],
     Map Text (Record MigrationLog))
 -> ([These Migration (Record MigrationLog)],
     Map Text (Record MigrationLog)))
-> ([These Migration (Record MigrationLog)],
    Map Text (Record MigrationLog))
-> [Migration]
-> ([These Migration (Record MigrationLog)],
    Map Text (Record MigrationLog))
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
foldr Element [Migration]
-> ([These Migration (Record MigrationLog)],
    Map Text (Record MigrationLog))
-> ([These Migration (Record MigrationLog)],
    Map Text (Record MigrationLog))
Migration
-> ([These Migration (Record MigrationLog)],
    Map Text (Record MigrationLog))
-> ([These Migration (Record MigrationLog)],
    Map Text (Record MigrationLog))
alignMigration ([], Map Text (Record MigrationLog)
migrationLogByKey) [Migration]
migrations

  [These Migration (Record MigrationLog)]
-> m [These Migration (Record MigrationLog)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([These Migration (Record MigrationLog)]
 -> m [These Migration (Record MigrationLog)])
-> [These Migration (Record MigrationLog)]
-> m [These Migration (Record MigrationLog)]
forall a b. (a -> b) -> a -> b
$ (Record MigrationLog -> These Migration (Record MigrationLog))
-> [Record MigrationLog] -> [These Migration (Record MigrationLog)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Record MigrationLog -> These Migration (Record MigrationLog)
forall a b. b -> These a b
That (Map Text (Record MigrationLog)
-> [Element (Map Text (Record MigrationLog))]
forall mono. MonoFoldable mono => mono -> [Element mono]
toList Map Text (Record MigrationLog)
extra) [These Migration (Record MigrationLog)]
-> [These Migration (Record MigrationLog)]
-> [These Migration (Record MigrationLog)]
forall m. Monoid m => m -> m -> m
++ [These Migration (Record MigrationLog)]
aligned