{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}

module Database.Beam.AutoMigrate.Validity
  ( -- * Types
    Reason (..),
    ApplyFailed,
    ValidationFailed,

    -- * Applying edits to a 'Schema'
    applyEdits,

    -- * Validing a 'Schema'
    validateSchema,
    validateSchemaTables,
    validateSchemaEnums,
    validateTableConstraint,
    validateColumn,
  )
where

import Control.Monad
import Control.Monad.Except
import Data.Bifunctor
import Data.Foldable
import qualified Data.List as L
import qualified Data.Map.Strict as M
import Data.Monoid
import qualified Data.Set as S
import Data.Text (Text)
import Database.Beam.AutoMigrate.Diff
import Database.Beam.AutoMigrate.Types
import Lens.Micro ((&))

-- | Simple type that allows us to talk about \"qualified entities\" like columns, which name might not be
-- unique globally (for which we need the 'TableName' to disambiguate things).
data Qualified a = Qualified TableName a deriving (Int -> Qualified a -> ShowS
[Qualified a] -> ShowS
Qualified a -> String
(Int -> Qualified a -> ShowS)
-> (Qualified a -> String)
-> ([Qualified a] -> ShowS)
-> Show (Qualified a)
forall a. Show a => Int -> Qualified a -> ShowS
forall a. Show a => [Qualified a] -> ShowS
forall a. Show a => Qualified a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Qualified a] -> ShowS
$cshowList :: forall a. Show a => [Qualified a] -> ShowS
show :: Qualified a -> String
$cshow :: forall a. Show a => Qualified a -> String
showsPrec :: Int -> Qualified a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Qualified a -> ShowS
Show, Qualified a -> Qualified a -> Bool
(Qualified a -> Qualified a -> Bool)
-> (Qualified a -> Qualified a -> Bool) -> Eq (Qualified a)
forall a. Eq a => Qualified a -> Qualified a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Qualified a -> Qualified a -> Bool
$c/= :: forall a. Eq a => Qualified a -> Qualified a -> Bool
== :: Qualified a -> Qualified a -> Bool
$c== :: forall a. Eq a => Qualified a -> Qualified a -> Bool
Eq)

data Reason
  = -- | The 'Table' we were trying to edit didn't exist.
    TableDoesntExist TableName
  | -- | The 'Table' we were trying to create already existed.
    TableAlreadyExist TableName Table
  | -- | The 'TableConstraint' we were trying to add already existed.
    TableConstraintAlreadyExist TableName TableConstraint
  | -- | The 'TableConstraint' we were trying to delete didn't exist.
    TableConstraintDoesntExist TableName TableConstraint
  | -- | The 'Column' we were trying to edit didn't exist.
    ColumnDoesntExist ColumnName
  | -- | The 'Column' we were trying to add already existed.
    ColumnAlreadyExist ColumnName Column
  | -- | The old type for the input 'Column' didn't match the type contained in the 'Edit' step.
    ColumnTypeMismatch ColumnName Column ColumnType
  | -- | The 'ColumnConstraint' we were trying to add already existed.
    ColumnConstraintAlreadyExist (Qualified ColumnName) ColumnConstraint
  | -- | The 'ColumnConstraint' we were trying to delete didn't exist.
    ColumnConstraintDoesntExist (Qualified ColumnName) ColumnConstraint
  | -- | The 'Enum' we were trying to edit didn't exist.
    EnumDoesntExist EnumerationName
  | -- | The 'Enum' we were trying to add already existed.
    EnumAlreadyExist EnumerationName Enumeration
  | -- | The value in this 'Enum' to be used to insert a new one before/after it didn't exist.
    EnumInsertionPointDoesntExist EnumerationName Enumeration Text
  | -- | The 'Sequence' we were trying to add already existed.
    SequenceAlreadyExist SequenceName Sequence
  | -- | The 'Sequence' we were trying to edit didn't exist.
    SequenceDoesntExist SequenceName
  | -- | This 'Table' references a deleted 'Column' in one of its 'TableConstraint's.
    TableReferencesDeletedColumnInConstraint TableName (Qualified ColumnName) TableConstraint
  | -- | This 'Column' references an 'Enum' which doesn't exist.
    ColumnReferencesNonExistingEnum (Qualified ColumnName) EnumerationName
  | -- | This 'Column' allows NULL values but it has been selected as a PRIMARY key.
    ColumnInPrimaryKeyCantBeNull (Qualified ColumnName)
  | -- | This 'Table' has a 'ForeignKey' constaint in it which references external columns which are either
    -- not unique or not fields of a PRIMARY KEY.
    ColumnsInFkAreNotUniqueOrPrimaryKeyFields TableName [Qualified ColumnName]
  | ColumnStillReferencesSequence SequenceName (Qualified ColumnName)
  | -- | This 'TableConstraint' references one or more 'Column's which don't exist.
    NotAllColumnsExist TableName (S.Set ColumnName) (S.Set ColumnName)
  | -- | Deleting this 'TableConstraint' would affect the selected external 'Column's and some external
    -- 'TableConstraint's.
    DeletedConstraintAffectsExternalTables (TableName, TableConstraint) (Qualified ColumnName, TableConstraint)
  | EnumContainsDuplicateValues EnumerationName [Text]
  deriving (Int -> Reason -> ShowS
[Reason] -> ShowS
Reason -> String
(Int -> Reason -> ShowS)
-> (Reason -> String) -> ([Reason] -> ShowS) -> Show Reason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reason] -> ShowS
$cshowList :: [Reason] -> ShowS
show :: Reason -> String
$cshow :: Reason -> String
showsPrec :: Int -> Reason -> ShowS
$cshowsPrec :: Int -> Reason -> ShowS
Show, Reason -> Reason -> Bool
(Reason -> Reason -> Bool)
-> (Reason -> Reason -> Bool) -> Eq Reason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reason -> Reason -> Bool
$c/= :: Reason -> Reason -> Bool
== :: Reason -> Reason -> Bool
$c== :: Reason -> Reason -> Bool
Eq)

data ApplyFailed
  = InvalidEdit Edit Reason
  deriving (Int -> ApplyFailed -> ShowS
[ApplyFailed] -> ShowS
ApplyFailed -> String
(Int -> ApplyFailed -> ShowS)
-> (ApplyFailed -> String)
-> ([ApplyFailed] -> ShowS)
-> Show ApplyFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplyFailed] -> ShowS
$cshowList :: [ApplyFailed] -> ShowS
show :: ApplyFailed -> String
$cshow :: ApplyFailed -> String
showsPrec :: Int -> ApplyFailed -> ShowS
$cshowsPrec :: Int -> ApplyFailed -> ShowS
Show, ApplyFailed -> ApplyFailed -> Bool
(ApplyFailed -> ApplyFailed -> Bool)
-> (ApplyFailed -> ApplyFailed -> Bool) -> Eq ApplyFailed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyFailed -> ApplyFailed -> Bool
$c/= :: ApplyFailed -> ApplyFailed -> Bool
== :: ApplyFailed -> ApplyFailed -> Bool
$c== :: ApplyFailed -> ApplyFailed -> Bool
Eq)

data ValidationFailed
  = InvalidTableConstraint TableConstraint Reason
  | InvalidRemoveTable TableName Reason
  | InvalidRemoveColumn (Qualified ColumnName) Reason
  | InvalidRemoveEnum EnumerationName Reason
  | InvalidRemoveSequence SequenceName Reason
  | InvalidEnum EnumerationName Reason
  | InvalidColumn (Qualified ColumnName) Reason
  | InvalidRemoveColumnConstraint (Qualified ColumnName) Reason
  | InvalidRemoveTableConstraint TableName Reason
  deriving (Int -> ValidationFailed -> ShowS
[ValidationFailed] -> ShowS
ValidationFailed -> String
(Int -> ValidationFailed -> ShowS)
-> (ValidationFailed -> String)
-> ([ValidationFailed] -> ShowS)
-> Show ValidationFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationFailed] -> ShowS
$cshowList :: [ValidationFailed] -> ShowS
show :: ValidationFailed -> String
$cshow :: ValidationFailed -> String
showsPrec :: Int -> ValidationFailed -> ShowS
$cshowsPrec :: Int -> ValidationFailed -> ShowS
Show, ValidationFailed -> ValidationFailed -> Bool
(ValidationFailed -> ValidationFailed -> Bool)
-> (ValidationFailed -> ValidationFailed -> Bool)
-> Eq ValidationFailed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationFailed -> ValidationFailed -> Bool
$c/= :: ValidationFailed -> ValidationFailed -> Bool
== :: ValidationFailed -> ValidationFailed -> Bool
$c== :: ValidationFailed -> ValidationFailed -> Bool
Eq)

--
-- Validating a Schema and a set of edit actions.
--

-- | Validate a 'Schema', returning an error in case the validation didn't succeed. We never contemplate
-- the case where any of the entities names are empty (i.e. the empty string) as that clearly indicates a
-- bug in the library, not a user error that needs to be reported.
validateSchema :: Schema -> Either [ValidationFailed] ()
validateSchema :: Schema -> Either [ValidationFailed] ()
validateSchema Schema
s = Except [ValidationFailed] () -> Either [ValidationFailed] ()
forall e a. Except e a -> Either e a
runExcept (Except [ValidationFailed] () -> Either [ValidationFailed] ())
-> Except [ValidationFailed] () -> Either [ValidationFailed] ()
forall a b. (a -> b) -> a -> b
$ do
  Either [ValidationFailed] () -> Except [ValidationFailed] ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Schema -> Either [ValidationFailed] ()
validateSchemaTables Schema
s)
  Either [ValidationFailed] () -> Except [ValidationFailed] ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Schema -> Either [ValidationFailed] ()
validateSchemaEnums Schema
s)

-- | A 'Table' is not valid if:
-- 1. Any of its 'Column's are not valid;
-- 2. Any of its 'TableConstraint's are not valid.
validateSchemaTables :: Schema -> Either [ValidationFailed] ()
validateSchemaTables :: Schema -> Either [ValidationFailed] ()
validateSchemaTables Schema
s = [(TableName, Table)]
-> ((TableName, Table) -> Either [ValidationFailed] ())
-> Either [ValidationFailed] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map TableName Table -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList (Map TableName Table -> [(TableName, Table)])
-> Map TableName Table -> [(TableName, Table)]
forall a b. (a -> b) -> a -> b
$ Schema -> Map TableName Table
schemaTables Schema
s) (TableName, Table) -> Either [ValidationFailed] ()
validateTable
  where
    validateTable :: (TableName, Table) -> Either [ValidationFailed] ()
    validateTable :: (TableName, Table) -> Either [ValidationFailed] ()
validateTable (TableName
tName, Table
tbl) = do
      Set TableConstraint
-> (TableConstraint -> Either [ValidationFailed] ())
-> Either [ValidationFailed] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Table -> Set TableConstraint
tableConstraints Table
tbl) ((ValidationFailed -> [ValidationFailed])
-> Either ValidationFailed () -> Either [ValidationFailed] ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ValidationFailed -> [ValidationFailed] -> [ValidationFailed]
forall a. a -> [a] -> [a]
: []) (Either ValidationFailed () -> Either [ValidationFailed] ())
-> (TableConstraint -> Either ValidationFailed ())
-> TableConstraint
-> Either [ValidationFailed] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema
-> TableName
-> Table
-> TableConstraint
-> Either ValidationFailed ()
validateTableConstraint Schema
s TableName
tName Table
tbl)
      [(ColumnName, Column)]
-> ((ColumnName, Column) -> Either [ValidationFailed] ())
-> Either [ValidationFailed] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map ColumnName Column -> [(ColumnName, Column)]
forall k a. Map k a -> [(k, a)]
M.toList (Map ColumnName Column -> [(ColumnName, Column)])
-> Map ColumnName Column -> [(ColumnName, Column)]
forall a b. (a -> b) -> a -> b
$ Table -> Map ColumnName Column
tableColumns Table
tbl) (Schema
-> TableName
-> (ColumnName, Column)
-> Either [ValidationFailed] ()
validateColumn Schema
s TableName
tName)

-- | Validate a 'TableConstraint', making sure referential integrity is not violated.
-- A Table constraint is valid IFF:
-- 1. For a 'PrimaryKey', all the referenced columns must exist in the 'Table';
-- 2. For a 'Unique', all the referenced columns must exist in the 'Table';
-- 3. For a 'ForeignKey', all the columns (both local and referenced) must exist;
-- 4. For a 'ForeignKey', the referenced columns must all be UNIQUE or PRIMARY keys.
validateTableConstraint :: Schema -> TableName -> Table -> TableConstraint -> Either ValidationFailed ()
validateTableConstraint :: Schema
-> TableName
-> Table
-> TableConstraint
-> Either ValidationFailed ()
validateTableConstraint Schema
s TableName
tName Table
tbl TableConstraint
c = case TableConstraint
c of
  PrimaryKey ConstraintName
_ Set ColumnName
cols | Set ColumnName
cols Set ColumnName -> Set ColumnName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set ColumnName
allTblColumns -> () -> Either ValidationFailed ()
forall a b. b -> Either a b
Right ()
  PrimaryKey ConstraintName
_ Set ColumnName
cols ->
    ValidationFailed -> Either ValidationFailed ()
forall a b. a -> Either a b
Left (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ TableConstraint -> Reason -> ValidationFailed
InvalidTableConstraint TableConstraint
c (TableName -> Set ColumnName -> Set ColumnName -> Reason
NotAllColumnsExist TableName
tName (Set ColumnName -> Set ColumnName -> Set ColumnName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set ColumnName
cols Set ColumnName
allTblColumns) Set ColumnName
allTblColumns)
  ForeignKey ConstraintName
_ TableName
referencedTable Set (ColumnName, ColumnName)
columnPairs ReferenceAction
_ ReferenceAction
_ -> TableName
-> Set (ColumnName, ColumnName) -> Either ValidationFailed ()
checkFkIntegrity TableName
referencedTable Set (ColumnName, ColumnName)
columnPairs
  Unique ConstraintName
_ Set ColumnName
cols | Set ColumnName
cols Set ColumnName -> Set ColumnName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set ColumnName
allTblColumns -> () -> Either ValidationFailed ()
forall a b. b -> Either a b
Right ()
  Unique ConstraintName
_ Set ColumnName
cols ->
    ValidationFailed -> Either ValidationFailed ()
forall a b. a -> Either a b
Left (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ TableConstraint -> Reason -> ValidationFailed
InvalidTableConstraint TableConstraint
c (TableName -> Set ColumnName -> Set ColumnName -> Reason
NotAllColumnsExist TableName
tName (Set ColumnName -> Set ColumnName -> Set ColumnName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set ColumnName
cols Set ColumnName
allTblColumns) Set ColumnName
allTblColumns)
  where
    allTblColumns :: S.Set ColumnName
    allTblColumns :: Set ColumnName
allTblColumns = Map ColumnName Column -> Set ColumnName
forall k a. Map k a -> Set k
M.keysSet (Map ColumnName Column -> Set ColumnName)
-> (Table -> Map ColumnName Column) -> Table -> Set ColumnName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> Map ColumnName Column
tableColumns (Table -> Set ColumnName) -> Table -> Set ColumnName
forall a b. (a -> b) -> a -> b
$ Table
tbl

    checkFkIntegrity :: TableName -> S.Set (ColumnName, ColumnName) -> Either ValidationFailed ()
    checkFkIntegrity :: TableName
-> Set (ColumnName, ColumnName) -> Either ValidationFailed ()
checkFkIntegrity TableName
referencedTable Set (ColumnName, ColumnName)
columnPairs = Except ValidationFailed () -> Either ValidationFailed ()
forall e a. Except e a -> Either e a
runExcept (Except ValidationFailed () -> Either ValidationFailed ())
-> Except ValidationFailed () -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$
      Either ValidationFailed () -> Except ValidationFailed ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ValidationFailed () -> Except ValidationFailed ())
-> Either ValidationFailed () -> Except ValidationFailed ()
forall a b. (a -> b) -> a -> b
$
        case TableName -> Map TableName Table -> Maybe Table
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TableName
referencedTable (Schema -> Map TableName Table
schemaTables Schema
s) of
          Maybe Table
Nothing -> ValidationFailed -> Either ValidationFailed ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ TableConstraint -> Reason -> ValidationFailed
InvalidTableConstraint TableConstraint
c (TableName -> Reason
TableDoesntExist TableName
referencedTable)
          Just Table
extTbl -> do
            let allExtColumns :: Set ColumnName
allExtColumns = Map ColumnName Column -> Set ColumnName
forall k a. Map k a -> Set k
M.keysSet (Table -> Map ColumnName Column
tableColumns Table
extTbl)
            let (Set ColumnName
localCols, Set ColumnName
referencedCols) = (((ColumnName, ColumnName) -> ColumnName)
-> Set (ColumnName, ColumnName) -> Set ColumnName
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (ColumnName, ColumnName) -> ColumnName
forall a b. (a, b) -> a
fst Set (ColumnName, ColumnName)
columnPairs, ((ColumnName, ColumnName) -> ColumnName)
-> Set (ColumnName, ColumnName) -> Set ColumnName
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (ColumnName, ColumnName) -> ColumnName
forall a b. (a, b) -> b
snd Set (ColumnName, ColumnName)
columnPairs)
            if
                | Bool -> Bool
not (Set ColumnName
localCols Set ColumnName -> Set ColumnName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set ColumnName
allTblColumns) ->
                  ValidationFailed -> Either ValidationFailed ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ TableConstraint -> Reason -> ValidationFailed
InvalidTableConstraint TableConstraint
c (TableName -> Set ColumnName -> Set ColumnName -> Reason
NotAllColumnsExist TableName
tName (Set ColumnName -> Set ColumnName -> Set ColumnName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set ColumnName
localCols Set ColumnName
allTblColumns) Set ColumnName
allTblColumns)
                | Bool -> Bool
not (Set ColumnName
referencedCols Set ColumnName -> Set ColumnName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set ColumnName
allExtColumns) ->
                  ValidationFailed -> Either ValidationFailed ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ TableConstraint -> Reason -> ValidationFailed
InvalidTableConstraint TableConstraint
c (TableName -> Set ColumnName -> Set ColumnName -> Reason
NotAllColumnsExist TableName
referencedTable (Set ColumnName -> Set ColumnName -> Set ColumnName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set ColumnName
referencedCols Set ColumnName
allTblColumns) Set ColumnName
allExtColumns)
                | Bool
otherwise -> TableName -> Table -> Set ColumnName -> Either ValidationFailed ()
checkColumnsIntegrity TableName
referencedTable Table
extTbl Set ColumnName
referencedCols

    -- Check that all these columns are either 'UNIQUE' or 'PRIMARY KEY' in the input 'Table'.
    checkColumnsIntegrity :: TableName -> Table -> S.Set ColumnName -> Either ValidationFailed ()
    checkColumnsIntegrity :: TableName -> Table -> Set ColumnName -> Either ValidationFailed ()
checkColumnsIntegrity TableName
extName Table
extTbl Set ColumnName
referencedCols =
      let checkConstraint :: TableConstraint -> Maybe ()
checkConstraint TableConstraint
extCon = case TableConstraint
extCon of
            ForeignKey {} -> Maybe ()
forall a. Maybe a
Nothing
            PrimaryKey ConstraintName
_ Set ColumnName
cols | Set ColumnName
referencedCols Set ColumnName -> Set ColumnName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set ColumnName
cols -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
            PrimaryKey {} -> Maybe ()
forall a. Maybe a
Nothing
            Unique ConstraintName
_ Set ColumnName
cols | Set ColumnName
referencedCols Set ColumnName -> Set ColumnName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set ColumnName
cols -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
            Unique {} -> Maybe ()
forall a. Maybe a
Nothing
       in case [Maybe ()] -> Maybe ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((TableConstraint -> Maybe ()) -> [TableConstraint] -> [Maybe ()]
forall a b. (a -> b) -> [a] -> [b]
map TableConstraint -> Maybe ()
checkConstraint (Set TableConstraint -> [TableConstraint]
forall a. Set a -> [a]
S.toList (Set TableConstraint -> [TableConstraint])
-> Set TableConstraint -> [TableConstraint]
forall a b. (a -> b) -> a -> b
$ Table -> Set TableConstraint
tableConstraints Table
extTbl)) of
            Maybe ()
Nothing ->
              let reason :: Reason
reason = TableName -> [Qualified ColumnName] -> Reason
ColumnsInFkAreNotUniqueOrPrimaryKeyFields TableName
tName ((ColumnName -> Qualified ColumnName)
-> [ColumnName] -> [Qualified ColumnName]
forall a b. (a -> b) -> [a] -> [b]
map (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
extName) (Set ColumnName -> [ColumnName]
forall a. Set a -> [a]
S.toList Set ColumnName
referencedCols))
               in ValidationFailed -> Either ValidationFailed ()
forall a b. a -> Either a b
Left (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ TableConstraint -> Reason -> ValidationFailed
InvalidTableConstraint TableConstraint
c Reason
reason
            Just () -> () -> Either ValidationFailed ()
forall a b. b -> Either a b
Right ()

-- | Validate 'Column'.
-- NOTE(adn) For now in this context a 'Column' is always considered valid, /except/ if it references an
-- 'Enum' type which doesn't exist.
validateColumn :: Schema -> TableName -> (ColumnName, Column) -> Either [ValidationFailed] ()
validateColumn :: Schema
-> TableName
-> (ColumnName, Column)
-> Either [ValidationFailed] ()
validateColumn Schema
s TableName
tName (ColumnName
colName, Column
col) =
  case (ColumnName, Column) -> Maybe EnumerationName
lookupEnum (ColumnName
colName, Column
col) of
    Maybe EnumerationName
Nothing -> () -> Either [ValidationFailed] ()
forall a b. b -> Either a b
Right ()
    Just EnumerationName
eName | EnumerationName
eName EnumerationName -> [EnumerationName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map EnumerationName Enumeration -> [EnumerationName]
forall k a. Map k a -> [k]
M.keys (Schema -> Map EnumerationName Enumeration
schemaEnumerations Schema
s) -> () -> Either [ValidationFailed] ()
forall a b. b -> Either a b
Right ()
    Just EnumerationName
eName ->
      let reason :: Reason
reason = Qualified ColumnName -> EnumerationName -> Reason
ColumnReferencesNonExistingEnum (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName) EnumerationName
eName
       in [ValidationFailed] -> Either [ValidationFailed] ()
forall a b. a -> Either a b
Left [Qualified ColumnName -> Reason -> ValidationFailed
InvalidColumn (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName) Reason
reason]

-- | A 'Schema' enum is considered always valid in this context /except/ if it contains duplicate values.
validateSchemaEnums :: Schema -> Either [ValidationFailed] ()
validateSchemaEnums :: Schema -> Either [ValidationFailed] ()
validateSchemaEnums Schema
s = [(EnumerationName, Enumeration)]
-> ((EnumerationName, Enumeration) -> Either [ValidationFailed] ())
-> Either [ValidationFailed] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map EnumerationName Enumeration -> [(EnumerationName, Enumeration)]
forall k a. Map k a -> [(k, a)]
M.toList (Map EnumerationName Enumeration
 -> [(EnumerationName, Enumeration)])
-> Map EnumerationName Enumeration
-> [(EnumerationName, Enumeration)]
forall a b. (a -> b) -> a -> b
$ Schema -> Map EnumerationName Enumeration
schemaEnumerations Schema
s) (EnumerationName, Enumeration) -> Either [ValidationFailed] ()
validateEnum
  where
    validateEnum :: (EnumerationName, Enumeration) -> Either [ValidationFailed] ()
    validateEnum :: (EnumerationName, Enumeration) -> Either [ValidationFailed] ()
validateEnum (EnumerationName
eName, (Enumeration [ConstraintName]
vals)) =
      if [ConstraintName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ConstraintName]
vals Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Set ConstraintName -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ConstraintName] -> Set ConstraintName
forall a. Ord a => [a] -> Set a
S.fromList [ConstraintName]
vals)
        then [ValidationFailed] -> Either [ValidationFailed] ()
forall a b. a -> Either a b
Left [EnumerationName -> Reason -> ValidationFailed
InvalidEnum EnumerationName
eName (EnumerationName -> [ConstraintName] -> Reason
EnumContainsDuplicateValues EnumerationName
eName [ConstraintName]
vals)]
        else () -> Either [ValidationFailed] ()
forall a b. b -> Either a b
Right ()

-- | Validate removal of a 'Table'.
-- Removing a 'Table' is valid if none of the column fields are referenced in any of the other tables.
validateRemoveTable :: Schema -> TableName -> Table -> Either ValidationFailed ()
validateRemoveTable :: Schema -> TableName -> Table -> Either ValidationFailed ()
validateRemoveTable Schema
s TableName
tName Table
tbl = do
  let tableColumnNames :: [Qualified ColumnName]
tableColumnNames = (ColumnName -> Qualified ColumnName)
-> [ColumnName] -> [Qualified ColumnName]
forall a b. (a -> b) -> [a] -> [b]
map (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName) ([ColumnName] -> [Qualified ColumnName])
-> [ColumnName] -> [Qualified ColumnName]
forall a b. (a -> b) -> a -> b
$ Map ColumnName Column -> [ColumnName]
forall k a. Map k a -> [k]
M.keys (Table -> Map ColumnName Column
tableColumns Table
tbl)
  let otherTables :: Map TableName Table
otherTables = TableName -> Map TableName Table -> Map TableName Table
forall k a. Ord k => k -> Map k a -> Map k a
M.delete TableName
tName (Schema -> Map TableName Table
schemaTables Schema
s)
  ((TableName, Table) -> Either ValidationFailed ())
-> [(TableName, Table)] -> Either ValidationFailed ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Qualified ColumnName]
-> (TableName, Table) -> Either ValidationFailed ()
checkIntegrity [Qualified ColumnName]
tableColumnNames) (Map TableName Table -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList Map TableName Table
otherTables)
  where
    checkIntegrity :: [Qualified ColumnName] -> (TableName, Table) -> Either ValidationFailed ()
    checkIntegrity :: [Qualified ColumnName]
-> (TableName, Table) -> Either ValidationFailed ()
checkIntegrity [Qualified ColumnName]
colNames (TableName
otherTblName, Table
otherTbl) =
      case Alt Maybe (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt Maybe (Qualified ColumnName, TableConstraint)
 -> Maybe (Qualified ColumnName, TableConstraint))
-> Alt Maybe (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall a b. (a -> b) -> a -> b
$ [Alt Maybe (Qualified ColumnName, TableConstraint)]
-> Alt Maybe (Qualified ColumnName, TableConstraint)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Qualified ColumnName
 -> Alt Maybe (Qualified ColumnName, TableConstraint))
-> [Qualified ColumnName]
-> [Alt Maybe (Qualified ColumnName, TableConstraint)]
forall a b. (a -> b) -> [a] -> [b]
map (TableName
-> Table
-> Qualified ColumnName
-> Alt Maybe (Qualified ColumnName, TableConstraint)
lookupColumnRef TableName
otherTblName Table
otherTbl) [Qualified ColumnName]
colNames) of
        Maybe (Qualified ColumnName, TableConstraint)
Nothing -> () -> Either ValidationFailed ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just (Qualified ColumnName
qualifiedColName, TableConstraint
constr) ->
          let reason :: Reason
reason = TableName -> Qualified ColumnName -> TableConstraint -> Reason
TableReferencesDeletedColumnInConstraint TableName
tName Qualified ColumnName
qualifiedColName TableConstraint
constr
           in ValidationFailed -> Either ValidationFailed ()
forall a b. a -> Either a b
Left (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ TableName -> Reason -> ValidationFailed
InvalidRemoveTable TableName
tName Reason
reason

-- | The workhorse of the validation engine. It lookups the input 'ColumnName' in any of the constraints
-- of the input 'Table'.
lookupColumnRef ::
  TableName ->
  Table ->
  Qualified ColumnName ->
  Alt Maybe (Qualified ColumnName, TableConstraint)
lookupColumnRef :: TableName
-> Table
-> Qualified ColumnName
-> Alt Maybe (Qualified ColumnName, TableConstraint)
lookupColumnRef TableName
thisTable (Table -> Set TableConstraint
tableConstraints -> Set TableConstraint
constr) (Qualified TableName
extTbl ColumnName
colName) =
  [Alt Maybe (Qualified ColumnName, TableConstraint)]
-> Alt Maybe (Qualified ColumnName, TableConstraint)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((TableConstraint
 -> Alt Maybe (Qualified ColumnName, TableConstraint))
-> [TableConstraint]
-> [Alt Maybe (Qualified ColumnName, TableConstraint)]
forall a b. (a -> b) -> [a] -> [b]
map TableConstraint
-> Alt Maybe (Qualified ColumnName, TableConstraint)
lookupReference (Set TableConstraint -> [TableConstraint]
forall a. Set a -> [a]
S.toList Set TableConstraint
constr))
  where
    lookupReference :: TableConstraint -> Alt Maybe (Qualified ColumnName, TableConstraint)
    lookupReference :: TableConstraint
-> Alt Maybe (Qualified ColumnName, TableConstraint)
lookupReference TableConstraint
con = Maybe (Qualified ColumnName, TableConstraint)
-> Alt Maybe (Qualified ColumnName, TableConstraint)
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Maybe (Qualified ColumnName, TableConstraint)
 -> Alt Maybe (Qualified ColumnName, TableConstraint))
-> Maybe (Qualified ColumnName, TableConstraint)
-> Alt Maybe (Qualified ColumnName, TableConstraint)
forall a b. (a -> b) -> a -> b
$ case TableConstraint
con of
      PrimaryKey ConstraintName
_ Set ColumnName
cols
        | TableName
thisTable TableName -> TableName -> Bool
forall a. Eq a => a -> a -> Bool
== TableName
extTbl ->
          if ColumnName -> Set ColumnName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ColumnName
colName Set ColumnName
cols then (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall a. a -> Maybe a
Just (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
thisTable ColumnName
colName, TableConstraint
con) else Maybe (Qualified ColumnName, TableConstraint)
forall a. Maybe a
Nothing
      PrimaryKey ConstraintName
_ Set ColumnName
_ -> Maybe (Qualified ColumnName, TableConstraint)
forall a. Maybe a
Nothing
      ForeignKey ConstraintName
_ TableName
extTbl' Set (ColumnName, ColumnName)
columnPairs ReferenceAction
_ ReferenceAction
_ ->
        let (Set ColumnName
localCols, Set ColumnName
referencedCols) = (((ColumnName, ColumnName) -> ColumnName)
-> Set (ColumnName, ColumnName) -> Set ColumnName
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (ColumnName, ColumnName) -> ColumnName
forall a b. (a, b) -> a
fst Set (ColumnName, ColumnName)
columnPairs, ((ColumnName, ColumnName) -> ColumnName)
-> Set (ColumnName, ColumnName) -> Set ColumnName
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (ColumnName, ColumnName) -> ColumnName
forall a b. (a, b) -> b
snd Set (ColumnName, ColumnName)
columnPairs)
         in if
                | ColumnName -> Set ColumnName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ColumnName
colName Set ColumnName
localCols Bool -> Bool -> Bool
&& TableName
thisTable TableName -> TableName -> Bool
forall a. Eq a => a -> a -> Bool
== TableName
extTbl -> (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall a. a -> Maybe a
Just (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
extTbl ColumnName
colName, TableConstraint
con)
                | ColumnName -> Set ColumnName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ColumnName
colName Set ColumnName
referencedCols Bool -> Bool -> Bool
&& TableName
extTbl TableName -> TableName -> Bool
forall a. Eq a => a -> a -> Bool
== TableName
extTbl' -> (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall a. a -> Maybe a
Just (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
extTbl ColumnName
colName, TableConstraint
con)
                | Bool
otherwise -> Maybe (Qualified ColumnName, TableConstraint)
forall a. Maybe a
Nothing
      Unique ConstraintName
_ Set ColumnName
cols
        | TableName
thisTable TableName -> TableName -> Bool
forall a. Eq a => a -> a -> Bool
== TableName
extTbl ->
          if ColumnName -> Set ColumnName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ColumnName
colName Set ColumnName
cols then (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall a. a -> Maybe a
Just (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
thisTable ColumnName
colName, TableConstraint
con) else Maybe (Qualified ColumnName, TableConstraint)
forall a. Maybe a
Nothing
      Unique ConstraintName
_ Set ColumnName
_ -> Maybe (Qualified ColumnName, TableConstraint)
forall a. Maybe a
Nothing

-- | Check that the input 'Column's type matches the input 'EnumerationName'.
lookupEnum :: (ColumnName, Column) -> Maybe EnumerationName
lookupEnum :: (ColumnName, Column) -> Maybe EnumerationName
lookupEnum (ColumnName
_colName, Column
col) =
  case Column -> ColumnType
columnType Column
col of
    PgSpecificType (PgEnumeration EnumerationName
eName) -> EnumerationName -> Maybe EnumerationName
forall a. a -> Maybe a
Just EnumerationName
eName
    ColumnType
_ -> Maybe EnumerationName
forall a. Maybe a
Nothing

-- | Check that the input 'Column's type matches the input 'EnumerationName'.
lookupEnumRef :: EnumerationName -> (ColumnName, Column) -> Alt Maybe ColumnName
lookupEnumRef :: EnumerationName -> (ColumnName, Column) -> Alt Maybe ColumnName
lookupEnumRef EnumerationName
eName (ColumnName
colName, Column
col) = Maybe ColumnName -> Alt Maybe ColumnName
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Maybe ColumnName -> Alt Maybe ColumnName)
-> Maybe ColumnName -> Alt Maybe ColumnName
forall a b. (a -> b) -> a -> b
$
  case Column -> ColumnType
columnType Column
col of
    PgSpecificType (PgEnumeration EnumerationName
eName') | EnumerationName
eName EnumerationName -> EnumerationName -> Bool
forall a. Eq a => a -> a -> Bool
== EnumerationName
eName' -> ColumnName -> Maybe ColumnName
forall a. a -> Maybe a
Just ColumnName
colName
    ColumnType
_ -> Maybe ColumnName
forall a. Maybe a
Nothing

-- | Removing an 'Enum' is valid if none of the 'Schema's tables have columns of this type.
validateRemoveEnum :: Schema -> EnumerationName -> Either ValidationFailed ()
validateRemoveEnum :: Schema -> EnumerationName -> Either ValidationFailed ()
validateRemoveEnum Schema
s EnumerationName
eName =
  let allTables :: [(TableName, Table)]
allTables = Map TableName Table -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList (Schema -> Map TableName Table
schemaTables Schema
s)
   in ((TableName, Table) -> Either ValidationFailed ())
-> [(TableName, Table)] -> Either ValidationFailed ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TableName, Table) -> Either ValidationFailed ()
checkIntegrity [(TableName, Table)]
allTables
  where
    checkIntegrity :: (TableName, Table) -> Either ValidationFailed ()
    checkIntegrity :: (TableName, Table) -> Either ValidationFailed ()
checkIntegrity (TableName
tName, Table
tbl) =
      case Alt Maybe ColumnName -> Maybe ColumnName
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt Maybe ColumnName -> Maybe ColumnName)
-> Alt Maybe ColumnName -> Maybe ColumnName
forall a b. (a -> b) -> a -> b
$ [Alt Maybe ColumnName] -> Alt Maybe ColumnName
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (((ColumnName, Column) -> Alt Maybe ColumnName)
-> [(ColumnName, Column)] -> [Alt Maybe ColumnName]
forall a b. (a -> b) -> [a] -> [b]
map (EnumerationName -> (ColumnName, Column) -> Alt Maybe ColumnName
lookupEnumRef EnumerationName
eName) (Map ColumnName Column -> [(ColumnName, Column)]
forall k a. Map k a -> [(k, a)]
M.toList (Map ColumnName Column -> [(ColumnName, Column)])
-> Map ColumnName Column -> [(ColumnName, Column)]
forall a b. (a -> b) -> a -> b
$ Table -> Map ColumnName Column
tableColumns Table
tbl)) of
        Maybe ColumnName
Nothing -> () -> Either ValidationFailed ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just ColumnName
colName ->
          let reason :: Reason
reason = Qualified ColumnName -> EnumerationName -> Reason
ColumnReferencesNonExistingEnum (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName) EnumerationName
eName
           in ValidationFailed -> Either ValidationFailed ()
forall a b. a -> Either a b
Left (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ EnumerationName -> Reason -> ValidationFailed
InvalidRemoveEnum EnumerationName
eName Reason
reason

-- | Checking that the removal of a 'Sequence' is valid requires us to store the 'TableName'
-- and the 'ColumnName' inside the 'Sequence' type, so that we can check in logarithmic time if this sequence
-- is still referenced by the target column.
validateRemoveSequence :: Schema -> SequenceName -> Sequence -> Either ValidationFailed ()
validateRemoveSequence :: Schema -> SequenceName -> Sequence -> Either ValidationFailed ()
validateRemoveSequence Schema
s SequenceName
sName (Sequence TableName
targetTable ColumnName
targetColumn) =
  let mbCol :: Maybe Bool
mbCol = do
        Table
tbl <- TableName -> Map TableName Table -> Maybe Table
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TableName
targetTable (Schema -> Map TableName Table
schemaTables Schema
s)
        Column
col <- ColumnName -> Map ColumnName Column -> Maybe Column
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ColumnName
targetColumn (Table -> Map ColumnName Column
tableColumns Table
tbl)
        Bool -> Maybe Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ (ColumnConstraint -> Bool) -> [ColumnConstraint] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ColumnConstraint -> Bool
hasNextValConstraint (Set ColumnConstraint -> [ColumnConstraint]
forall a. Set a -> [a]
S.toList (Column -> Set ColumnConstraint
columnConstraints Column
col))
   in case Maybe Bool
mbCol of
        Just Bool
True ->
          let reason :: Reason
reason = SequenceName -> Qualified ColumnName -> Reason
ColumnStillReferencesSequence SequenceName
sName (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
targetTable ColumnName
targetColumn)
           in ValidationFailed -> Either ValidationFailed ()
forall a b. a -> Either a b
Left (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ SequenceName -> Reason -> ValidationFailed
InvalidRemoveSequence SequenceName
sName Reason
reason
        Maybe Bool
_ -> () -> Either ValidationFailed ()
forall a b. b -> Either a b
Right ()
  where
    hasNextValConstraint :: ColumnConstraint -> Bool
    hasNextValConstraint :: ColumnConstraint -> Bool
hasNextValConstraint (Default ConstraintName
defTxt) = case SequenceName -> Maybe (TableName, ColumnName)
parseSequenceName (ConstraintName -> SequenceName
SequenceName ConstraintName
defTxt) of
      Just (TableName
tName, ColumnName
cName) | TableName
tName TableName -> TableName -> Bool
forall a. Eq a => a -> a -> Bool
== TableName
targetTable Bool -> Bool -> Bool
&& ColumnName
cName ColumnName -> ColumnName -> Bool
forall a. Eq a => a -> a -> Bool
== ColumnName
targetColumn -> Bool
True
      Maybe (TableName, ColumnName)
_ -> Bool
False
    hasNextValConstraint ColumnConstraint
_ = Bool
False

-- | Validate that adding a new 'TableConstraint' doesn't violate referential integrity.
validateAddTableConstraint :: Schema -> TableName -> Table -> TableConstraint -> Either ValidationFailed ()
validateAddTableConstraint :: Schema
-> TableName
-> Table
-> TableConstraint
-> Either ValidationFailed ()
validateAddTableConstraint = Schema
-> TableName
-> Table
-> TableConstraint
-> Either ValidationFailed ()
validateTableConstraint

-- | Removing a Table constraint is valid IFF:
-- 1. For a 'PrimaryKey' we need to check that none of the columns appears in any 'ForeignKey' constraints
--    of the other tables;
-- 2. For a 'Unique', we must check that none of the columns appear in any 'ForeignKey' of of the other
--    tables.
-- 3. For a 'ForeignKey', no check is necessary.
validateRemoveTableConstraint :: Schema -> TableName -> TableConstraint -> Either ValidationFailed ()
validateRemoveTableConstraint :: Schema
-> TableName -> TableConstraint -> Either ValidationFailed ()
validateRemoveTableConstraint Schema
s TableName
tName TableConstraint
c = case TableConstraint
c of
  PrimaryKey ConstraintName
_ Set ColumnName
cols ->
    [(TableName, Table)]
-> ((TableName, Table) -> Either ValidationFailed ())
-> Either ValidationFailed ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map TableName Table -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList Map TableName Table
allOtherTables) ([Qualified ColumnName]
-> (TableName, Table) -> Either ValidationFailed ()
checkIntegrity ((ColumnName -> Qualified ColumnName)
-> [ColumnName] -> [Qualified ColumnName]
forall a b. (a -> b) -> [a] -> [b]
map (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName) ([ColumnName] -> [Qualified ColumnName])
-> (Set ColumnName -> [ColumnName])
-> Set ColumnName
-> [Qualified ColumnName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ColumnName -> [ColumnName]
forall a. Set a -> [a]
S.toList (Set ColumnName -> [Qualified ColumnName])
-> Set ColumnName -> [Qualified ColumnName]
forall a b. (a -> b) -> a -> b
$ Set ColumnName
cols))
  Unique ConstraintName
_ Set ColumnName
cols ->
    [(TableName, Table)]
-> ((TableName, Table) -> Either ValidationFailed ())
-> Either ValidationFailed ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map TableName Table -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList Map TableName Table
allOtherTables) ([Qualified ColumnName]
-> (TableName, Table) -> Either ValidationFailed ()
checkIntegrity ((ColumnName -> Qualified ColumnName)
-> [ColumnName] -> [Qualified ColumnName]
forall a b. (a -> b) -> [a] -> [b]
map (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName) ([ColumnName] -> [Qualified ColumnName])
-> (Set ColumnName -> [ColumnName])
-> Set ColumnName
-> [Qualified ColumnName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ColumnName -> [ColumnName]
forall a. Set a -> [a]
S.toList (Set ColumnName -> [Qualified ColumnName])
-> Set ColumnName -> [Qualified ColumnName]
forall a b. (a -> b) -> a -> b
$ Set ColumnName
cols))
  ForeignKey {} -> () -> Either ValidationFailed ()
forall a b. b -> Either a b
Right ()
  where
    allOtherTables :: Tables
    allOtherTables :: Map TableName Table
allOtherTables = TableName -> Map TableName Table -> Map TableName Table
forall k a. Ord k => k -> Map k a -> Map k a
M.delete TableName
tName (Schema -> Map TableName Table
schemaTables Schema
s)

    checkIntegrity :: [Qualified ColumnName] -> (TableName, Table) -> Either ValidationFailed ()
    checkIntegrity :: [Qualified ColumnName]
-> (TableName, Table) -> Either ValidationFailed ()
checkIntegrity [Qualified ColumnName]
ourColNames (TableName
extTable, Table
tbl) =
      case Alt Maybe (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt Maybe (Qualified ColumnName, TableConstraint)
 -> Maybe (Qualified ColumnName, TableConstraint))
-> Alt Maybe (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall a b. (a -> b) -> a -> b
$ [Alt Maybe (Qualified ColumnName, TableConstraint)]
-> Alt Maybe (Qualified ColumnName, TableConstraint)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Qualified ColumnName
 -> Alt Maybe (Qualified ColumnName, TableConstraint))
-> [Qualified ColumnName]
-> [Alt Maybe (Qualified ColumnName, TableConstraint)]
forall a b. (a -> b) -> [a] -> [b]
map (TableName
-> Table
-> Qualified ColumnName
-> Alt Maybe (Qualified ColumnName, TableConstraint)
lookupColumnRef TableName
extTable Table
tbl) [Qualified ColumnName]
ourColNames) of
        Maybe (Qualified ColumnName, TableConstraint)
Nothing -> () -> Either ValidationFailed ()
forall a b. b -> Either a b
Right ()
        Just (Qualified ColumnName
colName, TableConstraint
constr) ->
          let reason :: Reason
reason = (TableName, TableConstraint)
-> (Qualified ColumnName, TableConstraint) -> Reason
DeletedConstraintAffectsExternalTables (TableName
tName, TableConstraint
c) (Qualified ColumnName
colName, TableConstraint
constr)
           in ValidationFailed -> Either ValidationFailed ()
forall a b. a -> Either a b
Left (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ TableName -> Reason -> ValidationFailed
InvalidRemoveTableConstraint TableName
tName Reason
reason

-- | Removing a 'Column' is valid iff the column is not referenced in any tables' constraints.
validateRemoveColumn :: Schema -> TableName -> ColumnName -> Either ValidationFailed ()
validateRemoveColumn :: Schema -> TableName -> ColumnName -> Either ValidationFailed ()
validateRemoveColumn Schema
s TableName
tName ColumnName
colName = ((TableName, Table) -> Either ValidationFailed ())
-> [(TableName, Table)] -> Either ValidationFailed ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TableName, Table) -> Either ValidationFailed ()
checkIntegrity (Map TableName Table -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList (Schema -> Map TableName Table
schemaTables Schema
s))
  where
    checkIntegrity :: (TableName, Table) -> Either ValidationFailed ()
    checkIntegrity :: (TableName, Table) -> Either ValidationFailed ()
checkIntegrity (TableName
otherTblName, Table
otherTbl) =
      case Alt Maybe (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt Maybe (Qualified ColumnName, TableConstraint)
 -> Maybe (Qualified ColumnName, TableConstraint))
-> Alt Maybe (Qualified ColumnName, TableConstraint)
-> Maybe (Qualified ColumnName, TableConstraint)
forall a b. (a -> b) -> a -> b
$ [Alt Maybe (Qualified ColumnName, TableConstraint)]
-> Alt Maybe (Qualified ColumnName, TableConstraint)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Qualified ColumnName
 -> Alt Maybe (Qualified ColumnName, TableConstraint))
-> [Qualified ColumnName]
-> [Alt Maybe (Qualified ColumnName, TableConstraint)]
forall a b. (a -> b) -> [a] -> [b]
map (TableName
-> Table
-> Qualified ColumnName
-> Alt Maybe (Qualified ColumnName, TableConstraint)
lookupColumnRef TableName
otherTblName Table
otherTbl) [TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName]) of
        Maybe (Qualified ColumnName, TableConstraint)
Nothing -> () -> Either ValidationFailed ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just (Qualified ColumnName
_, TableConstraint
constr) ->
          let reason :: Reason
reason = TableName -> Qualified ColumnName -> TableConstraint -> Reason
TableReferencesDeletedColumnInConstraint TableName
otherTblName (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName) TableConstraint
constr
           in ValidationFailed -> Either ValidationFailed ()
forall a b. a -> Either a b
Left (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ Qualified ColumnName -> Reason -> ValidationFailed
InvalidRemoveColumn (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName) Reason
reason

-- | Removing a column constraint will violate referential integrity if the constraint is 'NotNull' and
-- this column appears in the primary key.
validateRemoveColumnConstraint ::
  Table ->
  Qualified ColumnName ->
  ColumnConstraint ->
  Either ValidationFailed ()
validateRemoveColumnConstraint :: Table
-> Qualified ColumnName
-> ColumnConstraint
-> Either ValidationFailed ()
validateRemoveColumnConstraint Table
tbl (Qualified TableName
tName ColumnName
colName) = \case
  ColumnConstraint
NotNull -> (TableConstraint -> Either ValidationFailed ())
-> Set TableConstraint -> Either ValidationFailed ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TableConstraint -> Either ValidationFailed ()
checkIntegrity (Table -> Set TableConstraint
tableConstraints Table
tbl)
  Default ConstraintName
_ -> () -> Either ValidationFailed ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    checkIntegrity :: TableConstraint -> Either ValidationFailed ()
    checkIntegrity :: TableConstraint -> Either ValidationFailed ()
checkIntegrity TableConstraint
constr = case TableConstraint
constr of
      PrimaryKey ConstraintName
_ Set ColumnName
cols ->
        let reason :: Reason
reason = Qualified ColumnName -> Reason
ColumnInPrimaryKeyCantBeNull (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName)
         in if ColumnName -> Set ColumnName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ColumnName
colName Set ColumnName
cols
              then ValidationFailed -> Either ValidationFailed ()
forall a b. a -> Either a b
Left (ValidationFailed -> Either ValidationFailed ())
-> ValidationFailed -> Either ValidationFailed ()
forall a b. (a -> b) -> a -> b
$ Qualified ColumnName -> Reason -> ValidationFailed
InvalidRemoveColumnConstraint (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName) Reason
reason
              else () -> Either ValidationFailed ()
forall a b. b -> Either a b
Right ()
      ForeignKey {} -> () -> Either ValidationFailed ()
forall a b. b -> Either a b
Right ()
      Unique {} -> () -> Either ValidationFailed ()
forall a b. b -> Either a b
Right ()

-- | Convert a 'ValidationFailed' into an 'ApplyFailed'.
toApplyFailed :: Edit -> ValidationFailed -> ApplyFailed
toApplyFailed :: Edit -> ValidationFailed -> ApplyFailed
toApplyFailed Edit
e (InvalidTableConstraint TableConstraint
_ Reason
reason) = Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e Reason
reason
toApplyFailed Edit
e (InvalidRemoveTable TableName
_ Reason
reason) = Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e Reason
reason
toApplyFailed Edit
e (InvalidRemoveColumn Qualified ColumnName
_ Reason
reason) = Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e Reason
reason
toApplyFailed Edit
e (InvalidRemoveEnum EnumerationName
_ Reason
reason) = Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e Reason
reason
toApplyFailed Edit
e (InvalidRemoveSequence SequenceName
_ Reason
reason) = Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e Reason
reason
toApplyFailed Edit
e (InvalidEnum EnumerationName
_ Reason
reason) = Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e Reason
reason
toApplyFailed Edit
e (InvalidColumn Qualified ColumnName
_ Reason
reason) = Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e Reason
reason
toApplyFailed Edit
e (InvalidRemoveColumnConstraint Qualified ColumnName
_ Reason
reason) = Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e Reason
reason
toApplyFailed Edit
e (InvalidRemoveTableConstraint TableName
_ Reason
reason) = Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e Reason
reason

-- | Tries to apply a list of edits to a 'Schema' to generate a new one. Fails with an 'ApplyFailed' error
-- if the input list of 'Edit's would generate an invalid 'Schema'.
applyEdits :: [WithPriority Edit] -> Schema -> Either ApplyFailed Schema
applyEdits :: [WithPriority Edit] -> Schema -> Either ApplyFailed Schema
applyEdits ([WithPriority Edit] -> [WithPriority Edit]
sortEdits -> [WithPriority Edit]
edits) Schema
s = (Schema -> Edit -> Either ApplyFailed Schema)
-> Schema -> [Edit] -> Either ApplyFailed Schema
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Schema -> Edit -> Either ApplyFailed Schema
applyEdit Schema
s ((WithPriority Edit -> Edit) -> [WithPriority Edit] -> [Edit]
forall a b. (a -> b) -> [a] -> [b]
map ((Edit, Priority) -> Edit
forall a b. (a, b) -> a
fst ((Edit, Priority) -> Edit)
-> (WithPriority Edit -> (Edit, Priority))
-> WithPriority Edit
-> Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithPriority Edit -> (Edit, Priority)
forall a. WithPriority a -> (a, Priority)
unPriority) [WithPriority Edit]
edits)

applyEdit :: Schema -> Edit -> Either ApplyFailed Schema
applyEdit :: Schema -> Edit -> Either ApplyFailed Schema
applyEdit Schema
s edit :: Edit
edit@(Edit EditAction
e Either EditCondition EditSafety
_safety) = Except ApplyFailed Schema -> Either ApplyFailed Schema
forall e a. Except e a -> Either e a
runExcept (Except ApplyFailed Schema -> Either ApplyFailed Schema)
-> Except ApplyFailed Schema -> Either ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ case EditAction
e of
  EditAction_Automatic AutomaticEditAction
ea -> case AutomaticEditAction
ea of
    TableAdded TableName
tName Table
tbl -> Either ApplyFailed Schema -> Except ApplyFailed Schema
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed Schema -> Except ApplyFailed Schema)
-> Either ApplyFailed Schema -> Except ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ do
      Map TableName Table
tables' <-
        (Maybe Table -> Either ApplyFailed (Maybe Table))
-> TableName
-> Map TableName Table
-> Either ApplyFailed (Map TableName Table)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF
          ( \case
              -- Constaints are added as a separate edit step.
              Maybe Table
Nothing -> Maybe Table -> Either ApplyFailed (Maybe Table)
forall a b. b -> Either a b
Right (Table -> Maybe Table
forall a. a -> Maybe a
Just Table
tbl {tableConstraints :: Set TableConstraint
tableConstraints = Set TableConstraint
forall a. Monoid a => a
mempty})
              Just Table
existing -> ApplyFailed -> Either ApplyFailed (Maybe Table)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
edit (TableName -> Table -> Reason
TableAlreadyExist TableName
tName Table
existing))
          )
          TableName
tName
          (Schema -> Map TableName Table
schemaTables Schema
s)
      Schema -> Either ApplyFailed Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Either ApplyFailed Schema)
-> Schema -> Either ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ Schema
s {schemaTables :: Map TableName Table
schemaTables = Map TableName Table
tables'}
    TableRemoved TableName
tName ->
      TableName
-> Edit
-> Schema
-> (Table -> Either ApplyFailed (Maybe Table))
-> Except ApplyFailed Schema
withExistingTable TableName
tName Edit
edit Schema
s (Edit
-> Schema -> TableName -> Table -> Either ApplyFailed (Maybe Table)
removeTable Edit
edit Schema
s TableName
tName)
    TableConstraintAdded TableName
tName TableConstraint
con ->
      TableName
-> Edit
-> Schema
-> (Table -> Either ApplyFailed (Maybe Table))
-> Except ApplyFailed Schema
withExistingTable TableName
tName Edit
edit Schema
s (Edit
-> Schema
-> TableConstraint
-> TableName
-> Table
-> Either ApplyFailed (Maybe Table)
addTableConstraint Edit
edit Schema
s TableConstraint
con TableName
tName)
    TableConstraintRemoved TableName
tName TableConstraint
con ->
      TableName
-> Edit
-> Schema
-> (Table -> Either ApplyFailed (Maybe Table))
-> Except ApplyFailed Schema
withExistingTable TableName
tName Edit
edit Schema
s (Edit
-> Schema
-> TableConstraint
-> TableName
-> Table
-> Either ApplyFailed (Maybe Table)
removeTableConstraint Edit
edit Schema
s TableConstraint
con TableName
tName)
    ColumnAdded TableName
tName ColumnName
colName Column
col ->
      TableName
-> Edit
-> Schema
-> (Table -> Either ApplyFailed (Maybe Table))
-> Except ApplyFailed Schema
withExistingTable TableName
tName Edit
edit Schema
s (Edit
-> ColumnName
-> Column
-> Table
-> Either ApplyFailed (Maybe Table)
addColumn Edit
edit ColumnName
colName Column
col)
    ColumnRemoved TableName
tName ColumnName
colName ->
      TableName
-> Edit
-> Schema
-> (Table -> Either ApplyFailed (Maybe Table))
-> Except ApplyFailed Schema
withExistingTable TableName
tName Edit
edit Schema
s (Edit
-> Schema
-> ColumnName
-> TableName
-> Table
-> Either ApplyFailed (Maybe Table)
removeColumn Edit
edit Schema
s ColumnName
colName TableName
tName)
    ColumnTypeChanged TableName
tName ColumnName
colName ColumnType
oldType ColumnType
newType ->
      TableName
-> ColumnName
-> Edit
-> Schema
-> (Table -> Column -> Either ApplyFailed (Maybe Column))
-> Except ApplyFailed Schema
withExistingColumn TableName
tName ColumnName
colName Edit
edit Schema
s (\Table
_ -> Edit
-> ColumnName
-> ColumnType
-> ColumnType
-> Column
-> Either ApplyFailed (Maybe Column)
changeColumnType Edit
edit ColumnName
colName ColumnType
oldType ColumnType
newType)
    ColumnConstraintAdded TableName
tName ColumnName
colName ColumnConstraint
con ->
      TableName
-> ColumnName
-> Edit
-> Schema
-> (Table -> Column -> Either ApplyFailed (Maybe Column))
-> Except ApplyFailed Schema
withExistingColumn TableName
tName ColumnName
colName Edit
edit Schema
s (\Table
_ -> Edit
-> TableName
-> ColumnConstraint
-> ColumnName
-> Column
-> Either ApplyFailed (Maybe Column)
addColumnConstraint Edit
edit TableName
tName ColumnConstraint
con ColumnName
colName)
    ColumnConstraintRemoved TableName
tName ColumnName
colName ColumnConstraint
con ->
      TableName
-> ColumnName
-> Edit
-> Schema
-> (Table -> Column -> Either ApplyFailed (Maybe Column))
-> Except ApplyFailed Schema
withExistingColumn TableName
tName ColumnName
colName Edit
edit Schema
s (\Table
tbl -> Edit
-> Table
-> TableName
-> ColumnName
-> ColumnConstraint
-> Column
-> Either ApplyFailed (Maybe Column)
removeColumnConstraint Edit
edit Table
tbl TableName
tName ColumnName
colName ColumnConstraint
con)
    EnumTypeAdded EnumerationName
eName Enumeration
enum -> Either ApplyFailed Schema -> Except ApplyFailed Schema
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed Schema -> Except ApplyFailed Schema)
-> Either ApplyFailed Schema -> Except ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ do
      Map EnumerationName Enumeration
enums' <-
        (Maybe Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> EnumerationName
-> Map EnumerationName Enumeration
-> Either ApplyFailed (Map EnumerationName Enumeration)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF
          ( \case
              Maybe Enumeration
Nothing -> Maybe Enumeration -> Either ApplyFailed (Maybe Enumeration)
forall a b. b -> Either a b
Right (Enumeration -> Maybe Enumeration
forall a. a -> Maybe a
Just Enumeration
enum)
              Just Enumeration
existing -> ApplyFailed -> Either ApplyFailed (Maybe Enumeration)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
edit (EnumerationName -> Enumeration -> Reason
EnumAlreadyExist EnumerationName
eName Enumeration
existing))
          )
          EnumerationName
eName
          (Schema -> Map EnumerationName Enumeration
schemaEnumerations Schema
s)
      Schema -> Either ApplyFailed Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Either ApplyFailed Schema)
-> Schema -> Either ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ Schema
s {schemaEnumerations :: Map EnumerationName Enumeration
schemaEnumerations = Map EnumerationName Enumeration
enums'}
    EnumTypeRemoved EnumerationName
eName ->
      EnumerationName
-> Edit
-> Schema
-> (Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> Except ApplyFailed Schema
withExistingEnum EnumerationName
eName Edit
edit Schema
s (Edit
-> Schema
-> EnumerationName
-> Enumeration
-> Either ApplyFailed (Maybe Enumeration)
removeEnum Edit
edit Schema
s EnumerationName
eName)
    EnumTypeValueAdded EnumerationName
eName ConstraintName
addedValue InsertionOrder
insOrder ConstraintName
insPoint ->
      EnumerationName
-> Edit
-> Schema
-> (Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> Except ApplyFailed Schema
withExistingEnum EnumerationName
eName Edit
edit Schema
s (Edit
-> EnumerationName
-> ConstraintName
-> InsertionOrder
-> ConstraintName
-> Enumeration
-> Either ApplyFailed (Maybe Enumeration)
addValueToEnum Edit
edit EnumerationName
eName ConstraintName
addedValue InsertionOrder
insOrder ConstraintName
insPoint)
    SequenceAdded SequenceName
sName Sequence
seqq -> Either ApplyFailed Schema -> Except ApplyFailed Schema
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed Schema -> Except ApplyFailed Schema)
-> Either ApplyFailed Schema -> Except ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ do
      Map SequenceName Sequence
seqs' <-
        (Maybe Sequence -> Either ApplyFailed (Maybe Sequence))
-> SequenceName
-> Map SequenceName Sequence
-> Either ApplyFailed (Map SequenceName Sequence)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF
          ( \case
              Maybe Sequence
Nothing -> Maybe Sequence -> Either ApplyFailed (Maybe Sequence)
forall a b. b -> Either a b
Right (Sequence -> Maybe Sequence
forall a. a -> Maybe a
Just Sequence
seqq)
              Just Sequence
existing -> ApplyFailed -> Either ApplyFailed (Maybe Sequence)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
edit (SequenceName -> Sequence -> Reason
SequenceAlreadyExist SequenceName
sName Sequence
existing))
          )
          SequenceName
sName
          (Schema -> Map SequenceName Sequence
schemaSequences Schema
s)
      Schema -> Either ApplyFailed Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Either ApplyFailed Schema)
-> Schema -> Either ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ Schema
s {schemaSequences :: Map SequenceName Sequence
schemaSequences = Map SequenceName Sequence
seqs'}
    SequenceRemoved SequenceName
sName ->
      SequenceName
-> Edit
-> Schema
-> (Sequence -> Either ApplyFailed (Maybe Sequence))
-> Except ApplyFailed Schema
withExistingSequence SequenceName
sName Edit
edit Schema
s (Edit
-> Schema
-> SequenceName
-> Sequence
-> Either ApplyFailed (Maybe Sequence)
removeSequence Edit
edit Schema
s SequenceName
sName)
  EditAction_Manual ManualEditAction
ea -> case ManualEditAction
ea of
    ColumnRenamed TableName
tName ColumnName
oldName ColumnName
newName -> TableName
-> Edit
-> Schema
-> (Table -> Either ApplyFailed (Maybe Table))
-> Except ApplyFailed Schema
withExistingTable TableName
tName Edit
edit Schema
s (Edit
-> ColumnName
-> ColumnName
-> Table
-> Either ApplyFailed (Maybe Table)
renameColumn Edit
edit ColumnName
oldName ColumnName
newName)
--
-- Various combinators for specific parts of a Schema
--

removeTable :: Edit -> Schema -> TableName -> Table -> Either ApplyFailed (Maybe Table)
removeTable :: Edit
-> Schema -> TableName -> Table -> Either ApplyFailed (Maybe Table)
removeTable Edit
e Schema
s TableName
tName Table
t = Except ApplyFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall e a. Except e a -> Either e a
runExcept (Except ApplyFailed (Maybe Table)
 -> Either ApplyFailed (Maybe Table))
-> (Either ValidationFailed (Maybe Table)
    -> Except ApplyFailed (Maybe Table))
-> Either ValidationFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationFailed -> ApplyFailed)
-> Except ValidationFailed (Maybe Table)
-> Except ApplyFailed (Maybe Table)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (Edit -> ValidationFailed -> ApplyFailed
toApplyFailed Edit
e) (Except ValidationFailed (Maybe Table)
 -> Except ApplyFailed (Maybe Table))
-> (Either ValidationFailed (Maybe Table)
    -> Except ValidationFailed (Maybe Table))
-> Either ValidationFailed (Maybe Table)
-> Except ApplyFailed (Maybe Table)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ValidationFailed (Maybe Table)
-> Except ValidationFailed (Maybe Table)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ValidationFailed (Maybe Table)
 -> Either ApplyFailed (Maybe Table))
-> Either ValidationFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ do
  Schema -> TableName -> Table -> Either ValidationFailed ()
validateRemoveTable Schema
s TableName
tName Table
t
  Maybe Table -> Either ValidationFailed (Maybe Table)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Table
forall a. Maybe a
Nothing

addColumn :: Edit -> ColumnName -> Column -> Table -> Either ApplyFailed (Maybe Table)
addColumn :: Edit
-> ColumnName
-> Column
-> Table
-> Either ApplyFailed (Maybe Table)
addColumn Edit
e ColumnName
colName Column
col Table
tbl = Either ApplyFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed (Maybe Table)
 -> Either ApplyFailed (Maybe Table))
-> Either ApplyFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ do
  Map ColumnName Column
columns' <-
    (Maybe Column -> Either ApplyFailed (Maybe Column))
-> ColumnName
-> Map ColumnName Column
-> Either ApplyFailed (Map ColumnName Column)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF
      ( \case
          -- Constraints are added as a separate edit step.
          Maybe Column
Nothing -> Maybe Column -> Either ApplyFailed (Maybe Column)
forall a b. b -> Either a b
Right (Column -> Maybe Column
forall a. a -> Maybe a
Just Column
col {columnConstraints :: Set ColumnConstraint
columnConstraints = Set ColumnConstraint
forall a. Monoid a => a
mempty})
          Just Column
existing -> ApplyFailed -> Either ApplyFailed (Maybe Column)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (ColumnName -> Column -> Reason
ColumnAlreadyExist ColumnName
colName Column
existing))
      )
      ColumnName
colName
      (Table -> Map ColumnName Column
tableColumns Table
tbl)
  Maybe Table -> Either ApplyFailed (Maybe Table)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Table -> Either ApplyFailed (Maybe Table))
-> Maybe Table -> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ Table -> Maybe Table
forall a. a -> Maybe a
Just Table
tbl {tableColumns :: Map ColumnName Column
tableColumns = Map ColumnName Column
columns'}

removeColumn :: Edit -> Schema -> ColumnName -> TableName -> Table -> Either ApplyFailed (Maybe Table)
removeColumn :: Edit
-> Schema
-> ColumnName
-> TableName
-> Table
-> Either ApplyFailed (Maybe Table)
removeColumn Edit
e Schema
s ColumnName
colName TableName
tName Table
tbl = Either ApplyFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed (Maybe Table)
 -> Either ApplyFailed (Maybe Table))
-> Either ApplyFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ do
  Map ColumnName Column
columns' <-
    (Maybe Column -> Either ApplyFailed (Maybe Column))
-> ColumnName
-> Map ColumnName Column
-> Either ApplyFailed (Map ColumnName Column)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF
      ( \case
          Maybe Column
Nothing -> ApplyFailed -> Either ApplyFailed (Maybe Column)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (ColumnName -> Reason
ColumnDoesntExist ColumnName
colName))
          Just Column
_ -> (ValidationFailed -> ApplyFailed)
-> Either ValidationFailed () -> Either ApplyFailed ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Edit -> ValidationFailed -> ApplyFailed
toApplyFailed Edit
e) (Schema -> TableName -> ColumnName -> Either ValidationFailed ()
validateRemoveColumn Schema
s TableName
tName ColumnName
colName) Either ApplyFailed ()
-> Either ApplyFailed (Maybe Column)
-> Either ApplyFailed (Maybe Column)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Column -> Either ApplyFailed (Maybe Column)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Column
forall a. Maybe a
Nothing
      )
      ColumnName
colName
      (Table -> Map ColumnName Column
tableColumns Table
tbl)
  Maybe Table -> Either ApplyFailed (Maybe Table)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Table -> Either ApplyFailed (Maybe Table))
-> Maybe Table -> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ Table -> Maybe Table
forall a. a -> Maybe a
Just Table
tbl {tableColumns :: Map ColumnName Column
tableColumns = Map ColumnName Column
columns'}

renameColumn ::
  Edit ->
  ColumnName ->
  -- | old name
  ColumnName ->
  -- | new name
  Table ->
  Either ApplyFailed (Maybe Table)
renameColumn :: Edit
-> ColumnName
-> ColumnName
-> Table
-> Either ApplyFailed (Maybe Table)
renameColumn Edit
e ColumnName
oldName ColumnName
newName Table
tbl = do
  let oldColumns :: Map ColumnName Column
oldColumns = Table -> Map ColumnName Column
tableColumns Table
tbl

  case ColumnName -> Map ColumnName Column -> Maybe Column
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ColumnName
newName Map ColumnName Column
oldColumns of
    Maybe Column
Nothing -> () -> Either ApplyFailed ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Column
c -> ApplyFailed -> Either ApplyFailed ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ApplyFailed -> Either ApplyFailed ())
-> ApplyFailed -> Either ApplyFailed ()
forall a b. (a -> b) -> a -> b
$ Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (Reason -> ApplyFailed) -> Reason -> ApplyFailed
forall a b. (a -> b) -> a -> b
$ ColumnName -> Column -> Reason
ColumnAlreadyExist ColumnName
newName Column
c

  Column
c <- case ColumnName -> Map ColumnName Column -> Maybe Column
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ColumnName
oldName Map ColumnName Column
oldColumns of
    Maybe Column
Nothing -> ApplyFailed -> Either ApplyFailed Column
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ApplyFailed -> Either ApplyFailed Column)
-> ApplyFailed -> Either ApplyFailed Column
forall a b. (a -> b) -> a -> b
$ Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (Reason -> ApplyFailed) -> Reason -> ApplyFailed
forall a b. (a -> b) -> a -> b
$ ColumnName -> Reason
ColumnDoesntExist ColumnName
oldName
    Just Column
c -> Column -> Either ApplyFailed Column
forall (f :: * -> *) a. Applicative f => a -> f a
pure Column
c

  let
    newColumns :: Map ColumnName Column
newColumns = Map ColumnName Column
oldColumns
      Map ColumnName Column
-> (Map ColumnName Column -> Map ColumnName Column)
-> Map ColumnName Column
forall a b. a -> (a -> b) -> b
& ColumnName -> Map ColumnName Column -> Map ColumnName Column
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ColumnName
oldName
      Map ColumnName Column
-> (Map ColumnName Column -> Map ColumnName Column)
-> Map ColumnName Column
forall a b. a -> (a -> b) -> b
& ColumnName
-> Column -> Map ColumnName Column -> Map ColumnName Column
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ColumnName
newName Column
c

  Maybe Table -> Either ApplyFailed (Maybe Table)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Table -> Either ApplyFailed (Maybe Table))
-> Maybe Table -> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ Table -> Maybe Table
forall a. a -> Maybe a
Just (Table -> Maybe Table) -> Table -> Maybe Table
forall a b. (a -> b) -> a -> b
$ Table
tbl {tableColumns :: Map ColumnName Column
tableColumns = Map ColumnName Column
newColumns}

changeColumnType ::
  Edit ->
  ColumnName ->
  -- | old type
  ColumnType ->
  -- | new type
  ColumnType ->
  Column ->
  Either ApplyFailed (Maybe Column)
changeColumnType :: Edit
-> ColumnName
-> ColumnType
-> ColumnType
-> Column
-> Either ApplyFailed (Maybe Column)
changeColumnType Edit
e ColumnName
colName ColumnType
oldType ColumnType
newType Column
col =
  if Column -> ColumnType
columnType Column
col ColumnType -> ColumnType -> Bool
forall a. Eq a => a -> a -> Bool
/= ColumnType
oldType
    then ApplyFailed -> Either ApplyFailed (Maybe Column)
forall a b. a -> Either a b
Left (ApplyFailed -> Either ApplyFailed (Maybe Column))
-> ApplyFailed -> Either ApplyFailed (Maybe Column)
forall a b. (a -> b) -> a -> b
$ Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (ColumnName -> Column -> ColumnType -> Reason
ColumnTypeMismatch ColumnName
colName Column
col ColumnType
oldType)
    else Maybe Column -> Either ApplyFailed (Maybe Column)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Column -> Either ApplyFailed (Maybe Column))
-> (Column -> Maybe Column)
-> Column
-> Either ApplyFailed (Maybe Column)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Maybe Column
forall a. a -> Maybe a
Just (Column -> Either ApplyFailed (Maybe Column))
-> Column -> Either ApplyFailed (Maybe Column)
forall a b. (a -> b) -> a -> b
$ Column
col {columnType :: ColumnType
columnType = ColumnType
newType}

addColumnConstraint ::
  Edit ->
  TableName ->
  ColumnConstraint ->
  ColumnName ->
  Column ->
  Either ApplyFailed (Maybe Column)
addColumnConstraint :: Edit
-> TableName
-> ColumnConstraint
-> ColumnName
-> Column
-> Either ApplyFailed (Maybe Column)
addColumnConstraint Edit
e TableName
tName ColumnConstraint
constr ColumnName
colName Column
col =
  let constraints :: Set ColumnConstraint
constraints = Column -> Set ColumnConstraint
columnConstraints Column
col
   in if ColumnConstraint -> Set ColumnConstraint -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ColumnConstraint
constr Set ColumnConstraint
constraints
        then ApplyFailed -> Either ApplyFailed (Maybe Column)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (Qualified ColumnName -> ColumnConstraint -> Reason
ColumnConstraintAlreadyExist (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName) ColumnConstraint
constr))
        else Maybe Column -> Either ApplyFailed (Maybe Column)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Column -> Either ApplyFailed (Maybe Column))
-> (Column -> Maybe Column)
-> Column
-> Either ApplyFailed (Maybe Column)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Maybe Column
forall a. a -> Maybe a
Just (Column -> Either ApplyFailed (Maybe Column))
-> Column -> Either ApplyFailed (Maybe Column)
forall a b. (a -> b) -> a -> b
$ Column
col {columnConstraints :: Set ColumnConstraint
columnConstraints = ColumnConstraint -> Set ColumnConstraint -> Set ColumnConstraint
forall a. Ord a => a -> Set a -> Set a
S.insert ColumnConstraint
constr Set ColumnConstraint
constraints}

removeColumnConstraint ::
  Edit ->
  Table ->
  TableName ->
  ColumnName ->
  ColumnConstraint ->
  Column ->
  Either ApplyFailed (Maybe Column)
removeColumnConstraint :: Edit
-> Table
-> TableName
-> ColumnName
-> ColumnConstraint
-> Column
-> Either ApplyFailed (Maybe Column)
removeColumnConstraint Edit
e Table
tbl TableName
tName ColumnName
colName ColumnConstraint
constr Column
col = do
  let constraints :: Set ColumnConstraint
constraints = Column -> Set ColumnConstraint
columnConstraints Column
col
  Set ColumnConstraint
constraints' <-
    if ColumnConstraint -> Set ColumnConstraint -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ColumnConstraint
constr Set ColumnConstraint
constraints
      then Set ColumnConstraint -> Either ApplyFailed (Set ColumnConstraint)
removeConstraint Set ColumnConstraint
constraints
      else ApplyFailed -> Either ApplyFailed (Set ColumnConstraint)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (Qualified ColumnName -> ColumnConstraint -> Reason
ColumnConstraintDoesntExist (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName) ColumnConstraint
constr))
  Maybe Column -> Either ApplyFailed (Maybe Column)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Column -> Either ApplyFailed (Maybe Column))
-> (Column -> Maybe Column)
-> Column
-> Either ApplyFailed (Maybe Column)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Maybe Column
forall a. a -> Maybe a
Just (Column -> Either ApplyFailed (Maybe Column))
-> Column -> Either ApplyFailed (Maybe Column)
forall a b. (a -> b) -> a -> b
$ Column
col {columnConstraints :: Set ColumnConstraint
columnConstraints = Set ColumnConstraint
constraints'}
  where
    removeConstraint :: S.Set ColumnConstraint -> Either ApplyFailed (S.Set ColumnConstraint)
    removeConstraint :: Set ColumnConstraint -> Either ApplyFailed (Set ColumnConstraint)
removeConstraint Set ColumnConstraint
constraints = Except ApplyFailed (Set ColumnConstraint)
-> Either ApplyFailed (Set ColumnConstraint)
forall e a. Except e a -> Either e a
runExcept (Except ApplyFailed (Set ColumnConstraint)
 -> Either ApplyFailed (Set ColumnConstraint))
-> (Either ValidationFailed (Set ColumnConstraint)
    -> Except ApplyFailed (Set ColumnConstraint))
-> Either ValidationFailed (Set ColumnConstraint)
-> Either ApplyFailed (Set ColumnConstraint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationFailed -> ApplyFailed)
-> Except ValidationFailed (Set ColumnConstraint)
-> Except ApplyFailed (Set ColumnConstraint)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (Edit -> ValidationFailed -> ApplyFailed
toApplyFailed Edit
e) (Except ValidationFailed (Set ColumnConstraint)
 -> Except ApplyFailed (Set ColumnConstraint))
-> (Either ValidationFailed (Set ColumnConstraint)
    -> Except ValidationFailed (Set ColumnConstraint))
-> Either ValidationFailed (Set ColumnConstraint)
-> Except ApplyFailed (Set ColumnConstraint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ValidationFailed (Set ColumnConstraint)
-> Except ValidationFailed (Set ColumnConstraint)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ValidationFailed (Set ColumnConstraint)
 -> Either ApplyFailed (Set ColumnConstraint))
-> Either ValidationFailed (Set ColumnConstraint)
-> Either ApplyFailed (Set ColumnConstraint)
forall a b. (a -> b) -> a -> b
$ do
      Table
-> Qualified ColumnName
-> ColumnConstraint
-> Either ValidationFailed ()
validateRemoveColumnConstraint Table
tbl (TableName -> ColumnName -> Qualified ColumnName
forall a. TableName -> a -> Qualified a
Qualified TableName
tName ColumnName
colName) ColumnConstraint
constr
      Set ColumnConstraint
-> Either ValidationFailed (Set ColumnConstraint)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColumnConstraint -> Set ColumnConstraint -> Set ColumnConstraint
forall a. Ord a => a -> Set a -> Set a
S.delete ColumnConstraint
constr Set ColumnConstraint
constraints)

-- | Performs an action over an existing 'Table', failing if the 'Table' doesn't exist.
withExistingTable ::
  TableName ->
  Edit ->
  Schema ->
  (Table -> Either ApplyFailed (Maybe Table)) ->
  Except ApplyFailed Schema
withExistingTable :: TableName
-> Edit
-> Schema
-> (Table -> Either ApplyFailed (Maybe Table))
-> Except ApplyFailed Schema
withExistingTable TableName
tName Edit
e Schema
s Table -> Either ApplyFailed (Maybe Table)
action = Either ApplyFailed Schema -> Except ApplyFailed Schema
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed Schema -> Except ApplyFailed Schema)
-> Either ApplyFailed Schema -> Except ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ do
  Map TableName Table
tables' <-
    (Maybe Table -> Either ApplyFailed (Maybe Table))
-> TableName
-> Map TableName Table
-> Either ApplyFailed (Map TableName Table)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF
      ( \case
          Maybe Table
Nothing -> ApplyFailed -> Either ApplyFailed (Maybe Table)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (TableName -> Reason
TableDoesntExist TableName
tName))
          Just Table
table -> Table -> Either ApplyFailed (Maybe Table)
action Table
table
      )
      TableName
tName
      (Schema -> Map TableName Table
schemaTables Schema
s)
  Schema -> Either ApplyFailed Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Either ApplyFailed Schema)
-> Schema -> Either ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ Schema
s {schemaTables :: Map TableName Table
schemaTables = Map TableName Table
tables'}

-- | Performs an action over an existing 'Column', failing if the 'Column' doesn't exist.
withExistingColumn ::
  TableName ->
  ColumnName ->
  Edit ->
  Schema ->
  (Table -> Column -> Either ApplyFailed (Maybe Column)) ->
  Except ApplyFailed Schema
withExistingColumn :: TableName
-> ColumnName
-> Edit
-> Schema
-> (Table -> Column -> Either ApplyFailed (Maybe Column))
-> Except ApplyFailed Schema
withExistingColumn TableName
tName ColumnName
colName Edit
e Schema
s Table -> Column -> Either ApplyFailed (Maybe Column)
action =
  TableName
-> Edit
-> Schema
-> (Table -> Either ApplyFailed (Maybe Table))
-> Except ApplyFailed Schema
withExistingTable
    TableName
tName
    Edit
e
    Schema
s
    ( \Table
tbl -> do
        Map ColumnName Column
columns' <-
          (Maybe Column -> Either ApplyFailed (Maybe Column))
-> ColumnName
-> Map ColumnName Column
-> Either ApplyFailed (Map ColumnName Column)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF
            ( \case
                Maybe Column
Nothing -> ApplyFailed -> Either ApplyFailed (Maybe Column)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (ColumnName -> Reason
ColumnDoesntExist ColumnName
colName))
                Just Column
existing -> Table -> Column -> Either ApplyFailed (Maybe Column)
action Table
tbl Column
existing
            )
            ColumnName
colName
            (Table -> Map ColumnName Column
tableColumns Table
tbl)
        Maybe Table -> Either ApplyFailed (Maybe Table)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Table -> Either ApplyFailed (Maybe Table))
-> Maybe Table -> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ Table -> Maybe Table
forall a. a -> Maybe a
Just Table
tbl {tableColumns :: Map ColumnName Column
tableColumns = Map ColumnName Column
columns'}
    )

-- | Performs an action over an existing 'Enum', failing if the 'Enum' doesn't exist.
withExistingEnum ::
  EnumerationName ->
  Edit ->
  Schema ->
  (Enumeration -> Either ApplyFailed (Maybe Enumeration)) ->
  Except ApplyFailed Schema
withExistingEnum :: EnumerationName
-> Edit
-> Schema
-> (Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> Except ApplyFailed Schema
withExistingEnum EnumerationName
eName Edit
e Schema
s Enumeration -> Either ApplyFailed (Maybe Enumeration)
action = Either ApplyFailed Schema -> Except ApplyFailed Schema
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed Schema -> Except ApplyFailed Schema)
-> Either ApplyFailed Schema -> Except ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ do
  Map EnumerationName Enumeration
enums' <-
    (Maybe Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> EnumerationName
-> Map EnumerationName Enumeration
-> Either ApplyFailed (Map EnumerationName Enumeration)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF
      ( \case
          Maybe Enumeration
Nothing -> ApplyFailed -> Either ApplyFailed (Maybe Enumeration)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (EnumerationName -> Reason
EnumDoesntExist EnumerationName
eName))
          Just Enumeration
enum -> Enumeration -> Either ApplyFailed (Maybe Enumeration)
action Enumeration
enum
      )
      EnumerationName
eName
      (Schema -> Map EnumerationName Enumeration
schemaEnumerations Schema
s)
  Schema -> Either ApplyFailed Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Either ApplyFailed Schema)
-> Schema -> Either ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ Schema
s {schemaEnumerations :: Map EnumerationName Enumeration
schemaEnumerations = Map EnumerationName Enumeration
enums'}

-- | Performs an action over an existing 'Sequence', failing if the 'Sequence' doesn't exist.
withExistingSequence ::
  SequenceName ->
  Edit ->
  Schema ->
  (Sequence -> Either ApplyFailed (Maybe Sequence)) ->
  Except ApplyFailed Schema
withExistingSequence :: SequenceName
-> Edit
-> Schema
-> (Sequence -> Either ApplyFailed (Maybe Sequence))
-> Except ApplyFailed Schema
withExistingSequence SequenceName
sName Edit
e Schema
s Sequence -> Either ApplyFailed (Maybe Sequence)
action = Either ApplyFailed Schema -> Except ApplyFailed Schema
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed Schema -> Except ApplyFailed Schema)
-> Either ApplyFailed Schema -> Except ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ do
  Map SequenceName Sequence
seqs' <-
    (Maybe Sequence -> Either ApplyFailed (Maybe Sequence))
-> SequenceName
-> Map SequenceName Sequence
-> Either ApplyFailed (Map SequenceName Sequence)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF
      ( \case
          Maybe Sequence
Nothing -> ApplyFailed -> Either ApplyFailed (Maybe Sequence)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (SequenceName -> Reason
SequenceDoesntExist SequenceName
sName))
          Just Sequence
enum -> Sequence -> Either ApplyFailed (Maybe Sequence)
action Sequence
enum
      )
      SequenceName
sName
      (Schema -> Map SequenceName Sequence
schemaSequences Schema
s)
  Schema -> Either ApplyFailed Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Either ApplyFailed Schema)
-> Schema -> Either ApplyFailed Schema
forall a b. (a -> b) -> a -> b
$ Schema
s {schemaSequences :: Map SequenceName Sequence
schemaSequences = Map SequenceName Sequence
seqs'}

addTableConstraint ::
  Edit ->
  Schema ->
  TableConstraint ->
  TableName ->
  Table ->
  Either ApplyFailed (Maybe Table)
addTableConstraint :: Edit
-> Schema
-> TableConstraint
-> TableName
-> Table
-> Either ApplyFailed (Maybe Table)
addTableConstraint Edit
e Schema
s TableConstraint
con TableName
tName Table
tbl = Either ApplyFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed (Maybe Table)
 -> Either ApplyFailed (Maybe Table))
-> Either ApplyFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ do
  let constraints :: Set TableConstraint
constraints = Table -> Set TableConstraint
tableConstraints Table
tbl
  Set TableConstraint
constraints' <-
    if TableConstraint -> Set TableConstraint -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member TableConstraint
con Set TableConstraint
constraints
      then ApplyFailed -> Either ApplyFailed (Set TableConstraint)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (TableName -> TableConstraint -> Reason
TableConstraintAlreadyExist TableName
tName TableConstraint
con))
      else Set TableConstraint -> Either ApplyFailed (Set TableConstraint)
addConstraint Set TableConstraint
constraints
  Maybe Table -> Either ApplyFailed (Maybe Table)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Table -> Either ApplyFailed (Maybe Table))
-> Maybe Table -> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ Table -> Maybe Table
forall a. a -> Maybe a
Just Table
tbl {tableConstraints :: Set TableConstraint
tableConstraints = Set TableConstraint
constraints'}
  where
    addConstraint :: S.Set TableConstraint -> Either ApplyFailed (S.Set TableConstraint)
    addConstraint :: Set TableConstraint -> Either ApplyFailed (Set TableConstraint)
addConstraint Set TableConstraint
cons = Except ApplyFailed (Set TableConstraint)
-> Either ApplyFailed (Set TableConstraint)
forall e a. Except e a -> Either e a
runExcept (Except ApplyFailed (Set TableConstraint)
 -> Either ApplyFailed (Set TableConstraint))
-> (Either ValidationFailed (Set TableConstraint)
    -> Except ApplyFailed (Set TableConstraint))
-> Either ValidationFailed (Set TableConstraint)
-> Either ApplyFailed (Set TableConstraint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationFailed -> ApplyFailed)
-> Except ValidationFailed (Set TableConstraint)
-> Except ApplyFailed (Set TableConstraint)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (Edit -> ValidationFailed -> ApplyFailed
toApplyFailed Edit
e) (Except ValidationFailed (Set TableConstraint)
 -> Except ApplyFailed (Set TableConstraint))
-> (Either ValidationFailed (Set TableConstraint)
    -> Except ValidationFailed (Set TableConstraint))
-> Either ValidationFailed (Set TableConstraint)
-> Except ApplyFailed (Set TableConstraint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ValidationFailed (Set TableConstraint)
-> Except ValidationFailed (Set TableConstraint)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ValidationFailed (Set TableConstraint)
 -> Either ApplyFailed (Set TableConstraint))
-> Either ValidationFailed (Set TableConstraint)
-> Either ApplyFailed (Set TableConstraint)
forall a b. (a -> b) -> a -> b
$ do
      Schema
-> TableName
-> Table
-> TableConstraint
-> Either ValidationFailed ()
validateAddTableConstraint Schema
s TableName
tName Table
tbl TableConstraint
con
      Set TableConstraint
-> Either ValidationFailed (Set TableConstraint)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set TableConstraint
 -> Either ValidationFailed (Set TableConstraint))
-> Set TableConstraint
-> Either ValidationFailed (Set TableConstraint)
forall a b. (a -> b) -> a -> b
$ TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => a -> Set a -> Set a
S.insert TableConstraint
con Set TableConstraint
cons

removeTableConstraint ::
  Edit ->
  Schema ->
  TableConstraint ->
  TableName ->
  Table ->
  Either ApplyFailed (Maybe Table)
removeTableConstraint :: Edit
-> Schema
-> TableConstraint
-> TableName
-> Table
-> Either ApplyFailed (Maybe Table)
removeTableConstraint Edit
e Schema
s TableConstraint
con TableName
tName Table
tbl = Either ApplyFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ApplyFailed (Maybe Table)
 -> Either ApplyFailed (Maybe Table))
-> Either ApplyFailed (Maybe Table)
-> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ do
  let constraints :: Set TableConstraint
constraints = Table -> Set TableConstraint
tableConstraints Table
tbl
  Set TableConstraint
constraints' <-
    if TableConstraint -> Set TableConstraint -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member TableConstraint
con Set TableConstraint
constraints
      then Set TableConstraint -> Either ApplyFailed (Set TableConstraint)
removeConstraint Set TableConstraint
constraints
      else ApplyFailed -> Either ApplyFailed (Set TableConstraint)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (TableName -> TableConstraint -> Reason
TableConstraintDoesntExist TableName
tName TableConstraint
con))
  Maybe Table -> Either ApplyFailed (Maybe Table)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Table -> Either ApplyFailed (Maybe Table))
-> Maybe Table -> Either ApplyFailed (Maybe Table)
forall a b. (a -> b) -> a -> b
$ Table -> Maybe Table
forall a. a -> Maybe a
Just Table
tbl {tableConstraints :: Set TableConstraint
tableConstraints = Set TableConstraint
constraints'}
  where
    removeConstraint :: S.Set TableConstraint -> Either ApplyFailed (S.Set TableConstraint)
    removeConstraint :: Set TableConstraint -> Either ApplyFailed (Set TableConstraint)
removeConstraint Set TableConstraint
cons = Except ApplyFailed (Set TableConstraint)
-> Either ApplyFailed (Set TableConstraint)
forall e a. Except e a -> Either e a
runExcept (Except ApplyFailed (Set TableConstraint)
 -> Either ApplyFailed (Set TableConstraint))
-> (Either ValidationFailed (Set TableConstraint)
    -> Except ApplyFailed (Set TableConstraint))
-> Either ValidationFailed (Set TableConstraint)
-> Either ApplyFailed (Set TableConstraint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationFailed -> ApplyFailed)
-> Except ValidationFailed (Set TableConstraint)
-> Except ApplyFailed (Set TableConstraint)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (Edit -> ValidationFailed -> ApplyFailed
toApplyFailed Edit
e) (Except ValidationFailed (Set TableConstraint)
 -> Except ApplyFailed (Set TableConstraint))
-> (Either ValidationFailed (Set TableConstraint)
    -> Except ValidationFailed (Set TableConstraint))
-> Either ValidationFailed (Set TableConstraint)
-> Except ApplyFailed (Set TableConstraint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ValidationFailed (Set TableConstraint)
-> Except ValidationFailed (Set TableConstraint)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ValidationFailed (Set TableConstraint)
 -> Either ApplyFailed (Set TableConstraint))
-> Either ValidationFailed (Set TableConstraint)
-> Either ApplyFailed (Set TableConstraint)
forall a b. (a -> b) -> a -> b
$ do
      Schema
-> TableName -> TableConstraint -> Either ValidationFailed ()
validateRemoveTableConstraint Schema
s TableName
tName TableConstraint
con
      Set TableConstraint
-> Either ValidationFailed (Set TableConstraint)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set TableConstraint
 -> Either ValidationFailed (Set TableConstraint))
-> Set TableConstraint
-> Either ValidationFailed (Set TableConstraint)
forall a b. (a -> b) -> a -> b
$ TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => a -> Set a -> Set a
S.delete TableConstraint
con Set TableConstraint
cons

removeEnum ::
  Edit ->
  Schema ->
  EnumerationName ->
  Enumeration ->
  Either ApplyFailed (Maybe Enumeration)
removeEnum :: Edit
-> Schema
-> EnumerationName
-> Enumeration
-> Either ApplyFailed (Maybe Enumeration)
removeEnum Edit
e Schema
s EnumerationName
eName Enumeration
_ = Except ApplyFailed (Maybe Enumeration)
-> Either ApplyFailed (Maybe Enumeration)
forall e a. Except e a -> Either e a
runExcept (Except ApplyFailed (Maybe Enumeration)
 -> Either ApplyFailed (Maybe Enumeration))
-> (Either ValidationFailed (Maybe Enumeration)
    -> Except ApplyFailed (Maybe Enumeration))
-> Either ValidationFailed (Maybe Enumeration)
-> Either ApplyFailed (Maybe Enumeration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationFailed -> ApplyFailed)
-> Except ValidationFailed (Maybe Enumeration)
-> Except ApplyFailed (Maybe Enumeration)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (Edit -> ValidationFailed -> ApplyFailed
toApplyFailed Edit
e) (Except ValidationFailed (Maybe Enumeration)
 -> Except ApplyFailed (Maybe Enumeration))
-> (Either ValidationFailed (Maybe Enumeration)
    -> Except ValidationFailed (Maybe Enumeration))
-> Either ValidationFailed (Maybe Enumeration)
-> Except ApplyFailed (Maybe Enumeration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ValidationFailed (Maybe Enumeration)
-> Except ValidationFailed (Maybe Enumeration)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ValidationFailed (Maybe Enumeration)
 -> Either ApplyFailed (Maybe Enumeration))
-> Either ValidationFailed (Maybe Enumeration)
-> Either ApplyFailed (Maybe Enumeration)
forall a b. (a -> b) -> a -> b
$ do
  Schema -> EnumerationName -> Either ValidationFailed ()
validateRemoveEnum Schema
s EnumerationName
eName
  Maybe Enumeration -> Either ValidationFailed (Maybe Enumeration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Enumeration
forall a. Maybe a
Nothing

addValueToEnum ::
  Edit ->
  EnumerationName ->
  -- | value to insert
  Text ->
  InsertionOrder ->
  -- | insertion point
  Text ->
  Enumeration ->
  Either ApplyFailed (Maybe Enumeration)
addValueToEnum :: Edit
-> EnumerationName
-> ConstraintName
-> InsertionOrder
-> ConstraintName
-> Enumeration
-> Either ApplyFailed (Maybe Enumeration)
addValueToEnum Edit
e EnumerationName
eName ConstraintName
addedValue InsertionOrder
insOrder ConstraintName
insPoint (Enumeration [ConstraintName]
vals) =
  case InsertionOrder
insOrder of
    InsertionOrder
Before ->
      case ConstraintName -> [ConstraintName] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex ConstraintName
insPoint [ConstraintName]
vals of
        Maybe Int
Nothing -> ApplyFailed -> Either ApplyFailed (Maybe Enumeration)
forall a b. a -> Either a b
Left (Edit -> Reason -> ApplyFailed
InvalidEdit Edit
e (EnumerationName -> Enumeration -> ConstraintName -> Reason
EnumInsertionPointDoesntExist EnumerationName
eName ([ConstraintName] -> Enumeration
Enumeration [ConstraintName]
vals) ConstraintName
insPoint))
        Just Int
ix | Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Maybe Enumeration -> Either ApplyFailed (Maybe Enumeration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> (Enumeration -> Maybe Enumeration)
-> Enumeration
-> Either ApplyFailed (Maybe Enumeration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumeration -> Maybe Enumeration
forall a. a -> Maybe a
Just (Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> Enumeration -> Either ApplyFailed (Maybe Enumeration)
forall a b. (a -> b) -> a -> b
$ [ConstraintName] -> Enumeration
Enumeration (ConstraintName
addedValue ConstraintName -> [ConstraintName] -> [ConstraintName]
forall a. a -> [a] -> [a]
: [ConstraintName]
vals)
        Just Int
ix ->
          let ([ConstraintName]
hd, [ConstraintName]
tl) = Int -> [ConstraintName] -> ([ConstraintName], [ConstraintName])
forall a. Int -> [a] -> ([a], [a])
L.splitAt (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [ConstraintName]
vals
           in Maybe Enumeration -> Either ApplyFailed (Maybe Enumeration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> (Enumeration -> Maybe Enumeration)
-> Enumeration
-> Either ApplyFailed (Maybe Enumeration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumeration -> Maybe Enumeration
forall a. a -> Maybe a
Just (Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> Enumeration -> Either ApplyFailed (Maybe Enumeration)
forall a b. (a -> b) -> a -> b
$ [ConstraintName] -> Enumeration
Enumeration ([ConstraintName]
hd [ConstraintName] -> [ConstraintName] -> [ConstraintName]
forall a. Semigroup a => a -> a -> a
<> (ConstraintName
addedValue ConstraintName -> [ConstraintName] -> [ConstraintName]
forall a. a -> [a] -> [a]
: [ConstraintName]
tl))
    InsertionOrder
After ->
      let ([ConstraintName]
hd, [ConstraintName]
tl) = (ConstraintName -> Bool)
-> [ConstraintName] -> ([ConstraintName], [ConstraintName])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break (ConstraintName
insPoint ConstraintName -> ConstraintName -> Bool
forall a. Eq a => a -> a -> Bool
==) [ConstraintName]
vals
       in Maybe Enumeration -> Either ApplyFailed (Maybe Enumeration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> (Enumeration -> Maybe Enumeration)
-> Enumeration
-> Either ApplyFailed (Maybe Enumeration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumeration -> Maybe Enumeration
forall a. a -> Maybe a
Just (Enumeration -> Either ApplyFailed (Maybe Enumeration))
-> Enumeration -> Either ApplyFailed (Maybe Enumeration)
forall a b. (a -> b) -> a -> b
$ [ConstraintName] -> Enumeration
Enumeration ([ConstraintName]
hd [ConstraintName] -> [ConstraintName] -> [ConstraintName]
forall a. Semigroup a => a -> a -> a
<> (ConstraintName
addedValue ConstraintName -> [ConstraintName] -> [ConstraintName]
forall a. a -> [a] -> [a]
: [ConstraintName]
tl))

removeSequence ::
  Edit ->
  Schema ->
  SequenceName ->
  Sequence ->
  Either ApplyFailed (Maybe Sequence)
removeSequence :: Edit
-> Schema
-> SequenceName
-> Sequence
-> Either ApplyFailed (Maybe Sequence)
removeSequence Edit
e Schema
s SequenceName
sName Sequence
sqss = Except ApplyFailed (Maybe Sequence)
-> Either ApplyFailed (Maybe Sequence)
forall e a. Except e a -> Either e a
runExcept (Except ApplyFailed (Maybe Sequence)
 -> Either ApplyFailed (Maybe Sequence))
-> (Either ValidationFailed (Maybe Sequence)
    -> Except ApplyFailed (Maybe Sequence))
-> Either ValidationFailed (Maybe Sequence)
-> Either ApplyFailed (Maybe Sequence)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationFailed -> ApplyFailed)
-> Except ValidationFailed (Maybe Sequence)
-> Except ApplyFailed (Maybe Sequence)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (Edit -> ValidationFailed -> ApplyFailed
toApplyFailed Edit
e) (Except ValidationFailed (Maybe Sequence)
 -> Except ApplyFailed (Maybe Sequence))
-> (Either ValidationFailed (Maybe Sequence)
    -> Except ValidationFailed (Maybe Sequence))
-> Either ValidationFailed (Maybe Sequence)
-> Except ApplyFailed (Maybe Sequence)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ValidationFailed (Maybe Sequence)
-> Except ValidationFailed (Maybe Sequence)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ValidationFailed (Maybe Sequence)
 -> Either ApplyFailed (Maybe Sequence))
-> Either ValidationFailed (Maybe Sequence)
-> Either ApplyFailed (Maybe Sequence)
forall a b. (a -> b) -> a -> b
$ do
  Schema -> SequenceName -> Sequence -> Either ValidationFailed ()
validateRemoveSequence Schema
s SequenceName
sName Sequence
sqss
  Maybe Sequence -> Either ValidationFailed (Maybe Sequence)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Sequence
forall a. Maybe a
Nothing