module Sqel.Migration.Consistency where import qualified Control.Exception as Base import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT, throwE, withExceptT) import qualified Data.Aeson as Aeson import Data.Aeson (FromJSON, ToJSON) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LByteString import Data.List.Extra (zipWithLongest) import qualified Data.Map.Strict as Map import Exon (exon) import Generics.SOP (NP (Nil, (:*))) import Lens.Micro ((.~), (^.)) import Path (Abs, Dir, File, Path, parseRelFile, toFilePath, (</>)) import Path.IO (createDirIfMissing, doesFileExist) import qualified Sqel.Data.Migration as Migration import Sqel.Data.Migration (Migration (Migration), Migrations (Migrations)) import qualified Sqel.Data.PgType as PgType import Sqel.Data.PgType ( ColumnType (ColumnComp, ColumnPrim), PgColumn (PgColumn), PgColumns (PgColumns), PgComposite (PgComposite), PgPrimName (PgPrimName), PgTable (PgTable), PgTypeRef (PgTypeRef), ) import Sqel.Data.PgTypeName (PgTableName, pattern PgTypeName) import Sqel.Data.Sql (Sql) import qualified Sqel.Sql.Type as Sql import Sqel.Text.Quote (squote) import System.IO.Error (IOError) import Sqel.Migration.Statement (migrationStatementSql, migrationStatements) tryIO :: MonadIO m => IO a -> m (Either Text a) tryIO :: forall (m :: * -> *) a. MonadIO m => IO a -> m (Either Text a) tryIO = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first forall b a. (Show a, IsString b) => a -> b show) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall e a. Exception e => IO a -> IO (Either e a) Base.try @IOError data MigrationMetadata = MigrationMetadata { MigrationMetadata -> PgTableName name :: PgTableName, MigrationMetadata -> PgColumns table :: PgColumns, MigrationMetadata -> [PgComposite] types :: [PgComposite], MigrationMetadata -> [Sql] statementsTable :: [Sql], MigrationMetadata -> [Sql] statementsMigration :: [Sql] } deriving stock (MigrationMetadata -> MigrationMetadata -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: MigrationMetadata -> MigrationMetadata -> Bool $c/= :: MigrationMetadata -> MigrationMetadata -> Bool == :: MigrationMetadata -> MigrationMetadata -> Bool $c== :: MigrationMetadata -> MigrationMetadata -> Bool Eq, Int -> MigrationMetadata -> ShowS [MigrationMetadata] -> ShowS MigrationMetadata -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [MigrationMetadata] -> ShowS $cshowList :: [MigrationMetadata] -> ShowS show :: MigrationMetadata -> String $cshow :: MigrationMetadata -> String showsPrec :: Int -> MigrationMetadata -> ShowS $cshowsPrec :: Int -> MigrationMetadata -> ShowS Show, forall x. Rep MigrationMetadata x -> MigrationMetadata forall x. MigrationMetadata -> Rep MigrationMetadata x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep MigrationMetadata x -> MigrationMetadata $cfrom :: forall x. MigrationMetadata -> Rep MigrationMetadata x Generic) deriving anyclass ([MigrationMetadata] -> Encoding [MigrationMetadata] -> Value MigrationMetadata -> Encoding MigrationMetadata -> Value forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a toEncodingList :: [MigrationMetadata] -> Encoding $ctoEncodingList :: [MigrationMetadata] -> Encoding toJSONList :: [MigrationMetadata] -> Value $ctoJSONList :: [MigrationMetadata] -> Value toEncoding :: MigrationMetadata -> Encoding $ctoEncoding :: MigrationMetadata -> Encoding toJSON :: MigrationMetadata -> Value $ctoJSON :: MigrationMetadata -> Value ToJSON, Value -> Parser [MigrationMetadata] Value -> Parser MigrationMetadata forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [MigrationMetadata] $cparseJSONList :: Value -> Parser [MigrationMetadata] parseJSON :: Value -> Parser MigrationMetadata $cparseJSON :: Value -> Parser MigrationMetadata FromJSON) tableStatements :: PgTable a -> [Sql] tableStatements :: forall {k} (a :: k). PgTable a -> [Sql] tableStatements PgTable a table = forall {k} (a :: k). PgTable a -> Sql Sql.createTable PgTable a table forall a. a -> [a] -> [a] : (PgComposite -> Sql Sql.createProdType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [PgComposite] types) where types :: [PgComposite] types = forall a b. (a, b) -> b snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall k a. Map k a -> [(k, a)] Map.toAscList (PgTable a table forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "types" a => a #types) tableMetadata :: PgTable a -> MigrationMetadata tableMetadata :: forall {k} (a :: k). PgTable a -> MigrationMetadata tableMetadata PgTable a table = MigrationMetadata { $sel:name:MigrationMetadata :: PgTableName name = PgTable a table forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "name" a => a #name, $sel:table:MigrationMetadata :: PgColumns table = PgTable a table forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "columns" a => a #columns, [PgComposite] types :: [PgComposite] $sel:types:MigrationMetadata :: [PgComposite] types, $sel:statementsTable:MigrationMetadata :: [Sql] statementsTable = forall {k} (a :: k). PgTable a -> [Sql] tableStatements PgTable a table, $sel:statementsMigration:MigrationMetadata :: [Sql] statementsMigration = [] } where types :: [PgComposite] types = forall a b. (a, b) -> b snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall k a. Map k a -> [(k, a)] Map.toAscList (PgTable a table forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "types" a => a #types) migrationMetadata :: Migration mig -> MigrationMetadata migrationMetadata :: forall (mig :: Mig). Migration mig -> MigrationMetadata migrationMetadata Migration {PgTable from $sel:tableFrom:Migration :: forall from to ext (m :: * -> *). Migration ('Mig from to m ext) -> PgTable from tableFrom :: PgTable from tableFrom, MigrationActions ext $sel:actions:Migration :: forall from to ext (m :: * -> *). Migration ('Mig from to m ext) -> MigrationActions ext actions :: MigrationActions ext actions} = forall {k} (a :: k). PgTable a -> MigrationMetadata tableMetadata PgTable from tableFrom forall a b. a -> (a -> b) -> b & forall a. IsLabel "statementsMigration" a => a #statementsMigration forall s t a b. ASetter s t a b -> b -> s -> t .~ (MigrationStatement -> Sql migrationStatementSql forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall ext. PgTableName -> MigrationActions ext -> [MigrationStatement] migrationStatements (PgTable from tableFrom forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "name" a => a #name) MigrationActions ext actions) currentMetadata :: Migration mig -> MigrationMetadata currentMetadata :: forall (mig :: Mig). Migration mig -> MigrationMetadata currentMetadata Migration {PgTable to $sel:tableTo:Migration :: forall from to ext (m :: * -> *). Migration ('Mig from to m ext) -> PgTable to tableTo :: PgTable to tableTo} = forall {k} (a :: k). PgTable a -> MigrationMetadata tableMetadata PgTable to tableTo migrationMetadatas :: NP Migration migs -> [MigrationMetadata] migrationMetadatas :: forall (migs :: [Mig]). NP Migration migs -> [MigrationMetadata] migrationMetadatas = \case NP Migration migs Nil -> [] Migration x m :* NP Migration xs ms -> forall (mig :: Mig). Migration mig -> MigrationMetadata migrationMetadata Migration x m forall a. a -> [a] -> [a] : forall (migs :: [Mig]). NP Migration migs -> [MigrationMetadata] migrationMetadatas NP Migration xs ms headMigrationMetadata :: NP Migration migs -> Maybe MigrationMetadata headMigrationMetadata :: forall (migs :: [Mig]). NP Migration migs -> Maybe MigrationMetadata headMigrationMetadata = \case NP Migration migs Nil -> forall a. Maybe a Nothing Migration x mig :* NP Migration xs _ -> forall a. a -> Maybe a Just (forall (mig :: Mig). Migration mig -> MigrationMetadata currentMetadata Migration x mig) migrationsMetadata :: Migrations m migs -> [MigrationMetadata] migrationsMetadata :: forall (m :: * -> *) (migs :: [Mig]). Migrations m migs -> [MigrationMetadata] migrationsMetadata (Migrations NP Migration migs migs) = forall a. [a] -> [a] reverse (forall a. Maybe a -> [a] maybeToList (forall (migs :: [Mig]). NP Migration migs -> Maybe MigrationMetadata headMigrationMetadata NP Migration migs migs) forall a. Semigroup a => a -> a -> a <> forall (migs :: [Mig]). NP Migration migs -> [MigrationMetadata] migrationMetadatas NP Migration migs migs) jsonFile :: PgTable a -> String jsonFile :: forall {k} (a :: k). PgTable a -> String jsonFile PgTable {$sel:name:PgTable :: forall {k} (a :: k). PgTable a -> PgTableName name = PgTypeName Text name} = [exon|##{name}.json|] jsonPath :: Monad m => Path Abs Dir -> PgTable a -> ExceptT Text m (Path Abs File) jsonPath :: forall {k} (m :: * -> *) (a :: k). Monad m => Path Abs Dir -> PgTable a -> ExceptT Text m (Path Abs File) jsonPath Path Abs Dir dir PgTable a table = do Path Rel File name <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a ExceptT (forall (f :: * -> *) a. Applicative f => a -> f a pure (forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first SomeException -> Text pathError (forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File) parseRelFile (forall {k} (a :: k). PgTable a -> String jsonFile PgTable a table)))) pure (Path Abs Dir dir forall b t. Path b Dir -> Path Rel t -> Path b t </> Path Rel File name) where pathError :: SomeException -> Text pathError SomeException _ = [exon|Table name couldn't be converted to a path: #{toText tname}|] tname :: String tname = forall {k} (a :: k). PgTable a -> String jsonFile PgTable a table writeMigrationMetadata :: MonadIO m => Path Abs Dir -> Migrations m migs -> ExceptT Text m () writeMigrationMetadata :: forall (m :: * -> *) (migs :: [Mig]). MonadIO m => Path Abs Dir -> Migrations m migs -> ExceptT Text m () writeMigrationMetadata Path Abs Dir dir migs :: Migrations m migs migs@(Migrations (Migration {PgTable from tableFrom :: PgTable from $sel:tableFrom:Migration :: forall from to ext (m :: * -> *). Migration ('Mig from to m ext) -> PgTable from tableFrom} :* NP Migration xs _)) = do Path Abs File path <- forall {k} (m :: * -> *) (a :: k). Monad m => Path Abs Dir -> PgTable a -> ExceptT Text m (Path Abs File) jsonPath Path Abs Dir dir PgTable from tableFrom let write :: IO () write = String -> ByteString -> IO () LByteString.writeFile (forall b t. Path b t -> String toFilePath Path Abs File path) (forall a. ToJSON a => a -> ByteString Aeson.encode (forall (m :: * -> *) (migs :: [Mig]). Migrations m migs -> [MigrationMetadata] migrationsMetadata Migrations m migs migs)) writeError :: Text -> Text writeError Text e = [exon|Couldn't write migration metadata to '#{show path}': #{e}|] forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a ExceptT (forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first Text -> Text writeError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m (Either Text a) tryIO (forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m () createDirIfMissing Bool True Path Abs Dir dir)) forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a ExceptT (forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first Text -> Text writeError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m (Either Text a) tryIO IO () write) writeMigrationMetadata Path Abs Dir _ (Migrations NP Migration migs Nil) = forall (f :: * -> *). Applicative f => f () unit readError :: Path Abs File -> Text -> Text readError :: Path Abs File -> Text -> Text readError Path Abs File path Text e = [exon|Couldn't read migration metadata from #{show path}: #{e}|] decodeError :: Path Abs File -> String -> Text decodeError :: Path Abs File -> String -> Text decodeError Path Abs File path String e = [exon|Migration metadata in '#{show path}' has invalid json format: ##{e}|] readMigrationMetadata :: MonadIO m => Path Abs Dir -> Migrations m migs -> ExceptT Text m (Maybe [MigrationMetadata]) readMigrationMetadata :: forall (m :: * -> *) (migs :: [Mig]). MonadIO m => Path Abs Dir -> Migrations m migs -> ExceptT Text m (Maybe [MigrationMetadata]) readMigrationMetadata Path Abs Dir dir (Migrations (Migration {PgTable from tableFrom :: PgTable from $sel:tableFrom:Migration :: forall from to ext (m :: * -> *). Migration ('Mig from to m ext) -> PgTable from tableFrom} :* NP Migration xs _)) = do Path Abs File path <- forall {k} (m :: * -> *) (a :: k). Monad m => Path Abs Dir -> PgTable a -> ExceptT Text m (Path Abs File) jsonPath Path Abs Dir dir PgTable from tableFrom forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall b a. b -> Either a b -> b fromRight Bool False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m (Either Text a) tryIO (forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool doesFileExist Path Abs File path)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Bool False -> forall (f :: * -> *) a. Applicative f => a -> f a pure forall a. Maybe a Nothing Bool True -> do ByteString j <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a ExceptT (forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first (Path Abs File -> Text -> Text readError Path Abs File path) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m (Either Text a) tryIO (String -> IO ByteString ByteString.readFile (forall b t. Path b t -> String toFilePath Path Abs File path))) forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a ExceptT (forall (f :: * -> *) a. Applicative f => a -> f a pure (forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first (Path Abs File -> String -> Text decodeError Path Abs File path) (forall a. FromJSON a => ByteString -> Either String a Aeson.eitherDecodeStrict' ByteString j))) readMigrationMetadata Path Abs Dir _ (Migrations NP Migration migs Nil) = forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE Text "Cannot test empty migrations" indent :: Functor t => t Text -> t Text indent :: forall (t :: * -> *). Functor t => t Text -> t Text indent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text " • " forall a. Semigroup a => a -> a -> a <>) showType :: ColumnType -> Text showType :: ColumnType -> Text showType = forall a. Exon a => a -> a squote forall b c a. (b -> c) -> (a -> b) -> a -> c . \case ColumnPrim {$sel:name:ColumnPrim :: ColumnType -> PgPrimName name = PgPrimName Text name} -> Text name ColumnComp { $sel:pgType:ColumnPrim :: ColumnType -> PgTypeRef pgType = PgTypeRef Text name } -> Text name columnMismatch :: Maybe PgColumn -> Maybe PgColumn -> Text columnMismatch :: Maybe PgColumn -> Maybe PgColumn -> Text columnMismatch Maybe PgColumn Nothing (Just (PgColumn PgColumnName name ColumnType tpe)) = [exon|A column '##{name}' with type #{showType tpe} was added.|] columnMismatch (Just (PgColumn PgColumnName name ColumnType tpe)) Maybe PgColumn Nothing = [exon|The column '##{name}' with type #{showType tpe} was removed.|] columnMismatch (Just (PgColumn PgColumnName gname ColumnType gtpe)) (Just (PgColumn PgColumnName cname ColumnType ctpe)) | PgColumnName gname forall a. Eq a => a -> a -> Bool == PgColumnName cname = [exon|The type of the column '##{gname}' was changed from #{showType gtpe} to #{showType ctpe}.|] | Bool otherwise = [exon|The column '##{gname}' with type #{showType gtpe} was replaced with the column '##{cname}' with type #{showType ctpe}.|] columnMismatch Maybe PgColumn Nothing Maybe PgColumn Nothing = Text "Internal error" compareType :: Text -> PgColumns -> PgColumns -> Maybe (NonEmpty Text) compareType :: Text -> PgColumns -> PgColumns -> Maybe (NonEmpty Text) compareType Text desc (PgColumns [PgColumn] golden) (PgColumns [PgColumn] current) = NonEmpty (Maybe PgColumn, Maybe PgColumn) -> NonEmpty Text mismatches forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. [a] -> Maybe (NonEmpty a) nonEmpty (forall a. (a -> Bool) -> [a] -> [a] filter (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall a. Eq a => a -> a -> Bool (/=)) (forall a b c. (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c] zipWithLongest (,) [PgColumn] golden [PgColumn] current)) where mismatches :: NonEmpty (Maybe PgColumn, Maybe PgColumn) -> NonEmpty Text mismatches NonEmpty (Maybe PgColumn, Maybe PgColumn) cols = [exon|#{desc} has mismatched columns:|] forall a. a -> [a] -> NonEmpty a :| (forall (t :: * -> *). Functor t => t Text -> t Text indent (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry Maybe PgColumn -> Maybe PgColumn -> Text columnMismatch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) a. Foldable t => t a -> [a] toList NonEmpty (Maybe PgColumn, Maybe PgColumn) cols)) compareComp :: Maybe PgComposite -> Maybe PgComposite -> Maybe (NonEmpty Text) compareComp :: Maybe PgComposite -> Maybe PgComposite -> Maybe (NonEmpty Text) compareComp Maybe PgComposite Nothing Maybe PgComposite Nothing = forall a. Maybe a Nothing compareComp Maybe PgComposite Nothing (Just (PgComposite (PgTypeName Text name) PgColumns _)) = forall a. a -> Maybe a Just [[exon|The type '#{name}' was added.|]] compareComp (Just (PgComposite (PgTypeName Text name) PgColumns _)) Maybe PgComposite Nothing = forall a. a -> Maybe a Just [[exon|The type '#{name}' was removed.|]] compareComp (Just (PgComposite (PgTypeName Text gname) PgColumns gcols)) (Just (PgComposite (PgTypeName Text cname) PgColumns ccols)) | Text gname forall a. Eq a => a -> a -> Bool == Text cname = Text -> PgColumns -> PgColumns -> Maybe (NonEmpty Text) compareType [exon|The composite type '#{gname}'|] PgColumns gcols PgColumns ccols | Bool otherwise = forall a. a -> Maybe a Just [[exon|The type '#{gname}' was replaced with a type named '#{cname}'.|]] compareStep :: MigrationMetadata -> MigrationMetadata -> Maybe (NonEmpty Text) compareStep :: MigrationMetadata -> MigrationMetadata -> Maybe (NonEmpty Text) compareStep MigrationMetadata golden MigrationMetadata current = forall (m :: * -> *) a. Monad m => m (m a) -> m a join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. [a] -> Maybe (NonEmpty a) nonEmpty (forall a. [Maybe a] -> [a] catMaybes [Maybe (NonEmpty Text)] mismatches) where mismatches :: [Maybe (NonEmpty Text)] mismatches = Text -> PgColumns -> PgColumns -> Maybe (NonEmpty Text) compareType [exon|The migration table '#{name}'|] (MigrationMetadata golden forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "table" a => a #table) (MigrationMetadata current forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "table" a => a #table) forall a. a -> [a] -> [a] : forall a b c. (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c] zipWithLongest (Maybe PgComposite -> Maybe PgComposite -> Maybe (NonEmpty Text) compareComp) (MigrationMetadata golden forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "types" a => a #types) (MigrationMetadata current forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "types" a => a #types) PgTypeName Text name = MigrationMetadata golden forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "name" a => a #name checkStep :: Maybe MigrationMetadata -> Maybe MigrationMetadata -> Maybe (NonEmpty Text) checkStep :: Maybe MigrationMetadata -> Maybe MigrationMetadata -> Maybe (NonEmpty Text) checkStep Maybe MigrationMetadata Nothing Maybe MigrationMetadata _ = forall a. Maybe a Nothing checkStep (Just MigrationMetadata golden) Maybe MigrationMetadata Nothing = let (PgTypeName Text name) = MigrationMetadata golden forall s a. s -> Getting a s a -> a ^. forall a. IsLabel "name" a => a #name in forall a. a -> Maybe a Just (forall (f :: * -> *) a. Applicative f => a -> f a pure [exon|A migration for #{name} was removed.|]) checkStep (Just MigrationMetadata golden) (Just MigrationMetadata current) = MigrationMetadata -> MigrationMetadata -> Maybe (NonEmpty Text) compareStep MigrationMetadata golden MigrationMetadata current checkMigrationConsistency :: [MigrationMetadata] -> [MigrationMetadata] -> Either (NonEmpty Text) () checkMigrationConsistency :: [MigrationMetadata] -> [MigrationMetadata] -> Either (NonEmpty Text) () checkMigrationConsistency [MigrationMetadata] golden [MigrationMetadata] current = forall r l. r -> Maybe l -> Either l r maybeToLeft () (forall (m :: * -> *) a. Monad m => m (m a) -> m a join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (forall a. [a] -> Maybe (NonEmpty a) nonEmpty (forall a. [Maybe a] -> [a] catMaybes (forall a b c. (Maybe a -> Maybe b -> c) -> [a] -> [b] -> [c] zipWithLongest Maybe MigrationMetadata -> Maybe MigrationMetadata -> Maybe (NonEmpty Text) checkStep [MigrationMetadata] golden [MigrationMetadata] current)))) single :: Functor m => ExceptT Text m a -> ExceptT (NonEmpty Text) m a single :: forall (m :: * -> *) a. Functor m => ExceptT Text m a -> ExceptT (NonEmpty Text) m a single = forall (m :: * -> *) e e' a. Functor m => (e -> e') -> ExceptT e m a -> ExceptT e' m a withExceptT forall (f :: * -> *) a. Applicative f => a -> f a pure result :: Functor m => ExceptT e m () -> m (Maybe e) result :: forall (m :: * -> *) e. Functor m => ExceptT e m () -> m (Maybe e) result = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap \case Left e e -> forall a. a -> Maybe a Just e e Right () -> forall a. Maybe a Nothing migrationConsistency :: MonadIO m => Path Abs Dir -> Migrations m migs -> Bool -> m (Maybe (NonEmpty Text)) migrationConsistency :: forall (m :: * -> *) (migs :: [Mig]). MonadIO m => Path Abs Dir -> Migrations m migs -> Bool -> m (Maybe (NonEmpty Text)) migrationConsistency Path Abs Dir dir Migrations m migs migs = forall (m :: * -> *) e. Functor m => ExceptT e m () -> m (Maybe e) result forall b c a. (b -> c) -> (a -> b) -> a -> c . \case Bool True -> forall (m :: * -> *) a. Functor m => ExceptT Text m a -> ExceptT (NonEmpty Text) m a single (forall (m :: * -> *) (migs :: [Mig]). MonadIO m => Path Abs Dir -> Migrations m migs -> ExceptT Text m () writeMigrationMetadata Path Abs Dir dir Migrations m migs migs) Bool False -> forall (m :: * -> *) a. Functor m => ExceptT Text m a -> ExceptT (NonEmpty Text) m a single (forall (m :: * -> *) (migs :: [Mig]). MonadIO m => Path Abs Dir -> Migrations m migs -> ExceptT Text m (Maybe [MigrationMetadata]) readMigrationMetadata Path Abs Dir dir Migrations m migs migs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Just [MigrationMetadata] golden -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a ExceptT (forall (f :: * -> *) a. Applicative f => a -> f a pure ([MigrationMetadata] -> [MigrationMetadata] -> Either (NonEmpty Text) () checkMigrationConsistency [MigrationMetadata] golden (forall (m :: * -> *) (migs :: [Mig]). Migrations m migs -> [MigrationMetadata] migrationsMetadata Migrations m migs migs))) Maybe [MigrationMetadata] Nothing -> forall (m :: * -> *) a. Functor m => ExceptT Text m a -> ExceptT (NonEmpty Text) m a single (forall (m :: * -> *) (migs :: [Mig]). MonadIO m => Path Abs Dir -> Migrations m migs -> ExceptT Text m () writeMigrationMetadata Path Abs Dir dir Migrations m migs migs)