{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}

module Database.Beam.AutoMigrate.Diff
  ( Diffable (..),
    Diff,
    Priority (..),
    WithPriority (..),

    -- * Reference implementation, for model-testing purposes
    diffColumnReferenceImplementation,
    diffTablesReferenceImplementation,
    diffTableReferenceImplementation,
    diffReferenceImplementation,

    -- * Hopefully-efficient implementation
    diffColumn,
    diffTables,
    diffTable,
    sortEdits,
  )
where

import Control.Exception (assert)
import Control.Monad
import Data.DList (DList)
import qualified Data.DList as D
import Data.Foldable (foldlM)
import Data.List (foldl', (\\))
import qualified Data.List as L
import Data.Map.Merge.Strict
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import Data.Text (Text)
import Data.Word (Word8)
import Database.Beam.AutoMigrate.Types

--
-- Simple typeclass to diff things
--

-- | Some notion of 'Priority'. The lower the value, the higher the priority.
newtype Priority = Priority Word8 deriving (Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
(Int -> Priority -> ShowS)
-> (Priority -> String) -> ([Priority] -> ShowS) -> Show Priority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Priority] -> ShowS
$cshowList :: [Priority] -> ShowS
show :: Priority -> String
$cshow :: Priority -> String
showsPrec :: Int -> Priority -> ShowS
$cshowsPrec :: Int -> Priority -> ShowS
Show, Priority -> Priority -> Bool
(Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool) -> Eq Priority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c== :: Priority -> Priority -> Bool
Eq, Eq Priority
Eq Priority
-> (Priority -> Priority -> Ordering)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Priority)
-> (Priority -> Priority -> Priority)
-> Ord Priority
Priority -> Priority -> Bool
Priority -> Priority -> Ordering
Priority -> Priority -> Priority
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Priority -> Priority -> Priority
$cmin :: Priority -> Priority -> Priority
max :: Priority -> Priority -> Priority
$cmax :: Priority -> Priority -> Priority
>= :: Priority -> Priority -> Bool
$c>= :: Priority -> Priority -> Bool
> :: Priority -> Priority -> Bool
$c> :: Priority -> Priority -> Bool
<= :: Priority -> Priority -> Bool
$c<= :: Priority -> Priority -> Bool
< :: Priority -> Priority -> Bool
$c< :: Priority -> Priority -> Bool
compare :: Priority -> Priority -> Ordering
$ccompare :: Priority -> Priority -> Ordering
$cp1Ord :: Eq Priority
Ord)

newtype WithPriority a = WithPriority {WithPriority a -> (a, Priority)
unPriority :: (a, Priority)} deriving (Int -> WithPriority a -> ShowS
[WithPriority a] -> ShowS
WithPriority a -> String
(Int -> WithPriority a -> ShowS)
-> (WithPriority a -> String)
-> ([WithPriority a] -> ShowS)
-> Show (WithPriority a)
forall a. Show a => Int -> WithPriority a -> ShowS
forall a. Show a => [WithPriority a] -> ShowS
forall a. Show a => WithPriority a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithPriority a] -> ShowS
$cshowList :: forall a. Show a => [WithPriority a] -> ShowS
show :: WithPriority a -> String
$cshow :: forall a. Show a => WithPriority a -> String
showsPrec :: Int -> WithPriority a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithPriority a -> ShowS
Show, WithPriority a -> WithPriority a -> Bool
(WithPriority a -> WithPriority a -> Bool)
-> (WithPriority a -> WithPriority a -> Bool)
-> Eq (WithPriority a)
forall a. Eq a => WithPriority a -> WithPriority a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithPriority a -> WithPriority a -> Bool
$c/= :: forall a. Eq a => WithPriority a -> WithPriority a -> Bool
== :: WithPriority a -> WithPriority a -> Bool
$c== :: forall a. Eq a => WithPriority a -> WithPriority a -> Bool
Eq, Eq (WithPriority a)
Eq (WithPriority a)
-> (WithPriority a -> WithPriority a -> Ordering)
-> (WithPriority a -> WithPriority a -> Bool)
-> (WithPriority a -> WithPriority a -> Bool)
-> (WithPriority a -> WithPriority a -> Bool)
-> (WithPriority a -> WithPriority a -> Bool)
-> (WithPriority a -> WithPriority a -> WithPriority a)
-> (WithPriority a -> WithPriority a -> WithPriority a)
-> Ord (WithPriority a)
WithPriority a -> WithPriority a -> Bool
WithPriority a -> WithPriority a -> Ordering
WithPriority a -> WithPriority a -> WithPriority a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (WithPriority a)
forall a. Ord a => WithPriority a -> WithPriority a -> Bool
forall a. Ord a => WithPriority a -> WithPriority a -> Ordering
forall a.
Ord a =>
WithPriority a -> WithPriority a -> WithPriority a
min :: WithPriority a -> WithPriority a -> WithPriority a
$cmin :: forall a.
Ord a =>
WithPriority a -> WithPriority a -> WithPriority a
max :: WithPriority a -> WithPriority a -> WithPriority a
$cmax :: forall a.
Ord a =>
WithPriority a -> WithPriority a -> WithPriority a
>= :: WithPriority a -> WithPriority a -> Bool
$c>= :: forall a. Ord a => WithPriority a -> WithPriority a -> Bool
> :: WithPriority a -> WithPriority a -> Bool
$c> :: forall a. Ord a => WithPriority a -> WithPriority a -> Bool
<= :: WithPriority a -> WithPriority a -> Bool
$c<= :: forall a. Ord a => WithPriority a -> WithPriority a -> Bool
< :: WithPriority a -> WithPriority a -> Bool
$c< :: forall a. Ord a => WithPriority a -> WithPriority a -> Bool
compare :: WithPriority a -> WithPriority a -> Ordering
$ccompare :: forall a. Ord a => WithPriority a -> WithPriority a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (WithPriority a)
Ord)

editPriority :: AutomaticEditAction -> Priority
editPriority :: AutomaticEditAction -> Priority
editPriority = \case
  -- Operations that create tables, sequences or enums have top priority
  EnumTypeAdded {} -> Word8 -> Priority
Priority Word8
0
  SequenceAdded {} -> Word8 -> Priority
Priority Word8
1
  TableAdded {} -> Word8 -> Priority
Priority Word8
2
  -- We cannot create a column if the relevant table (or enum type) is not there.
  ColumnAdded {} -> Word8 -> Priority
Priority Word8
3
  -- Operations that set constraints or change the shape of a type have lower priority
  ColumnTypeChanged {} -> Word8 -> Priority
Priority Word8
4
  EnumTypeValueAdded {} -> Word8 -> Priority
Priority Word8
5
  -- foreign keys need to go last, as the referenced columns needs to be either UNIQUE or have PKs.
  TableConstraintAdded TableName
_ Unique {} -> Word8 -> Priority
Priority Word8
6
  TableConstraintAdded TableName
_ PrimaryKey {} -> Word8 -> Priority
Priority Word8
7
  TableConstraintAdded TableName
_ ForeignKey {} -> Word8 -> Priority
Priority Word8
8
  ColumnConstraintAdded {} -> Word8 -> Priority
Priority Word8
9
  TableConstraintRemoved {} -> Word8 -> Priority
Priority Word8
10
  ColumnConstraintRemoved {} -> Word8 -> Priority
Priority Word8
11
  -- Destructive operations go last
  ColumnRemoved {} -> Word8 -> Priority
Priority Word8
12
  TableRemoved {} -> Word8 -> Priority
Priority Word8
13
  EnumTypeRemoved {} -> Word8 -> Priority
Priority Word8
14
  SequenceRemoved {} -> Word8 -> Priority
Priority Word8
15

-- TODO: This needs to support adding conditional queries.
mkEdit :: AutomaticEditAction -> WithPriority Edit
mkEdit :: AutomaticEditAction -> WithPriority Edit
mkEdit AutomaticEditAction
e = (Edit, Priority) -> WithPriority Edit
forall a. (a, Priority) -> WithPriority a
WithPriority (AutomaticEditAction -> Edit
defMkEdit AutomaticEditAction
e, AutomaticEditAction -> Priority
editPriority AutomaticEditAction
e)

-- | Sort edits according to their execution order, to make sure they don't reference
-- something which hasn't been created yet.
sortEdits :: [WithPriority Edit] -> [WithPriority Edit]
sortEdits :: [WithPriority Edit] -> [WithPriority Edit]
sortEdits = (WithPriority Edit -> Priority)
-> [WithPriority Edit] -> [WithPriority Edit]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn ((Edit, Priority) -> Priority
forall a b. (a, b) -> b
snd ((Edit, Priority) -> Priority)
-> (WithPriority Edit -> (Edit, Priority))
-> WithPriority Edit
-> Priority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithPriority Edit -> (Edit, Priority)
forall a. WithPriority a -> (a, Priority)
unPriority)

type DiffA t = Either DiffError (t (WithPriority Edit))

type Diff = DiffA []

-- NOTE(adn) Accumulate all the errors independently instead of short circuiting?
class Diffable a where
  diff :: a -> a -> Diff

-- | Computes the diff between two 'Schema's, either failing with a 'DiffError'
-- or returning the list of 'Edit's necessary to turn the first into the second.
instance Diffable Schema where
  diff :: Schema -> Schema -> Diff
diff Schema
hsSchema Schema
dbSchema = do
    [WithPriority Edit]
tableDiffs <- Tables -> Tables -> Diff
forall a. Diffable a => a -> a -> Diff
diff (Schema -> Tables
schemaTables Schema
hsSchema) (Schema -> Tables
schemaTables Schema
dbSchema)
    [WithPriority Edit]
enumDiffs <- Enumerations -> Enumerations -> Diff
forall a. Diffable a => a -> a -> Diff
diff (Schema -> Enumerations
schemaEnumerations Schema
hsSchema) (Schema -> Enumerations
schemaEnumerations Schema
dbSchema)
    [WithPriority Edit]
sequenceDiffs <- Sequences -> Sequences -> Diff
forall a. Diffable a => a -> a -> Diff
diff (Schema -> Sequences
schemaSequences Schema
hsSchema) (Schema -> Sequences
schemaSequences Schema
dbSchema)
    [WithPriority Edit] -> Diff
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Diff) -> [WithPriority Edit] -> Diff
forall a b. (a -> b) -> a -> b
$ [WithPriority Edit]
tableDiffs [WithPriority Edit] -> [WithPriority Edit] -> [WithPriority Edit]
forall a. Semigroup a => a -> a -> a
<> [WithPriority Edit]
enumDiffs [WithPriority Edit] -> [WithPriority Edit] -> [WithPriority Edit]
forall a. Semigroup a => a -> a -> a
<> [WithPriority Edit]
sequenceDiffs

instance Diffable Tables where
  diff :: Tables -> Tables -> Diff
diff Tables
t1 = (DList (WithPriority Edit) -> [WithPriority Edit])
-> Either DiffError (DList (WithPriority Edit)) -> Diff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (WithPriority Edit) -> [WithPriority Edit]
forall a. DList a -> [a]
D.toList (Either DiffError (DList (WithPriority Edit)) -> Diff)
-> (Tables -> Either DiffError (DList (WithPriority Edit)))
-> Tables
-> Diff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tables -> Tables -> Either DiffError (DList (WithPriority Edit))
diffTables Tables
t1

instance Diffable Enumerations where
  diff :: Enumerations -> Enumerations -> Diff
diff Enumerations
e1 = (DList (WithPriority Edit) -> [WithPriority Edit])
-> Either DiffError (DList (WithPriority Edit)) -> Diff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (WithPriority Edit) -> [WithPriority Edit]
forall a. DList a -> [a]
D.toList (Either DiffError (DList (WithPriority Edit)) -> Diff)
-> (Enumerations -> Either DiffError (DList (WithPriority Edit)))
-> Enumerations
-> Diff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumerations
-> Enumerations -> Either DiffError (DList (WithPriority Edit))
diffEnums Enumerations
e1

instance Diffable Sequences where
  diff :: Sequences -> Sequences -> Diff
diff Sequences
s1 = (DList (WithPriority Edit) -> [WithPriority Edit])
-> Either DiffError (DList (WithPriority Edit)) -> Diff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (WithPriority Edit) -> [WithPriority Edit]
forall a. DList a -> [a]
D.toList (Either DiffError (DList (WithPriority Edit)) -> Diff)
-> (Sequences -> Either DiffError (DList (WithPriority Edit)))
-> Sequences
-> Diff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequences
-> Sequences -> Either DiffError (DList (WithPriority Edit))
diffSequences Sequences
s1

--
-- Reference implementation
--

diffReferenceImplementation :: Schema -> Schema -> Diff
diffReferenceImplementation :: Schema -> Schema -> Diff
diffReferenceImplementation Schema
hsSchema = Tables -> Tables -> Diff
forall a. Diffable a => a -> a -> Diff
diff (Schema -> Tables
schemaTables Schema
hsSchema) (Tables -> Diff) -> (Schema -> Tables) -> Schema -> Diff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Tables
schemaTables

-- | A slow but hopefully correct implementation of the diffing algorithm, for QuickCheck comparison with
-- more sophisticated ones.
diffTablesReferenceImplementation :: Tables -> Tables -> Diff
diffTablesReferenceImplementation :: Tables -> Tables -> Diff
diffTablesReferenceImplementation Tables
hsTables Tables
dbTables = do
  let tablesAdded :: Tables
tablesAdded = Tables -> Tables -> Tables
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference Tables
hsTables Tables
dbTables
      tablesRemoved :: Tables
tablesRemoved = Tables -> Tables -> Tables
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference Tables
dbTables Tables
hsTables
      diffableTables :: Tables
diffableTables = Tables -> Tables -> Tables
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.intersection Tables
hsTables Tables
dbTables
      diffableTables' :: Tables
diffableTables' = Tables -> Tables -> Tables
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.intersection Tables
dbTables Tables
hsTables
  [WithPriority Edit]
whenBoth <- ([WithPriority Edit]
 -> ((TableName, Table), (TableName, Table)) -> Diff)
-> [WithPriority Edit]
-> [((TableName, Table), (TableName, Table))]
-> Diff
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM [WithPriority Edit]
-> ((TableName, Table), (TableName, Table)) -> Diff
go [WithPriority Edit]
forall a. Monoid a => a
mempty ([(TableName, Table)]
-> [(TableName, Table)]
-> [((TableName, Table), (TableName, Table))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Tables -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList Tables
diffableTables) (Tables -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList Tables
diffableTables'))
  [WithPriority Edit] -> Diff
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Diff) -> [WithPriority Edit] -> Diff
forall a b. (a -> b) -> a -> b
$ Tables -> [WithPriority Edit]
whenAdded Tables
tablesAdded [WithPriority Edit] -> [WithPriority Edit] -> [WithPriority Edit]
forall a. Semigroup a => a -> a -> a
<> Tables -> [WithPriority Edit]
whenRemoved Tables
tablesRemoved [WithPriority Edit] -> [WithPriority Edit] -> [WithPriority Edit]
forall a. Semigroup a => a -> a -> a
<> [WithPriority Edit]
whenBoth
  where
    whenAdded :: Tables -> [WithPriority Edit]
    whenAdded :: Tables -> [WithPriority Edit]
whenAdded = ((TableName, Table) -> [WithPriority Edit])
-> [(TableName, Table)] -> [WithPriority Edit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((TableName -> Table -> AutomaticEditAction)
-> (TableName -> TableConstraint -> AutomaticEditAction)
-> (Table -> Set TableConstraint)
-> (TableName, Table)
-> [WithPriority Edit]
forall k v c.
(k -> v -> AutomaticEditAction)
-> (k -> c -> AutomaticEditAction)
-> (v -> Set c)
-> (k, v)
-> [WithPriority Edit]
addEdit TableName -> Table -> AutomaticEditAction
TableAdded TableName -> TableConstraint -> AutomaticEditAction
TableConstraintAdded Table -> Set TableConstraint
tableConstraints) ([(TableName, Table)] -> [WithPriority Edit])
-> (Tables -> [(TableName, Table)])
-> Tables
-> [WithPriority Edit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tables -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList

    whenRemoved :: Tables -> [WithPriority Edit]
    whenRemoved :: Tables -> [WithPriority Edit]
whenRemoved =
      ((TableName, Table) -> [WithPriority Edit])
-> [(TableName, Table)] -> [WithPriority Edit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((TableName -> Table -> AutomaticEditAction)
-> (TableName -> TableConstraint -> AutomaticEditAction)
-> (Table -> Set TableConstraint)
-> (TableName, Table)
-> [WithPriority Edit]
forall k v c.
(k -> v -> AutomaticEditAction)
-> (k -> c -> AutomaticEditAction)
-> (v -> Set c)
-> (k, v)
-> [WithPriority Edit]
addEdit (\TableName
k Table
_ -> TableName -> AutomaticEditAction
TableRemoved TableName
k) TableName -> TableConstraint -> AutomaticEditAction
TableConstraintRemoved Table -> Set TableConstraint
tableConstraints) ([(TableName, Table)] -> [WithPriority Edit])
-> (Tables -> [(TableName, Table)])
-> Tables
-> [WithPriority Edit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tables -> [(TableName, Table)]
forall k a. Map k a -> [(k, a)]
M.toList

    go :: [WithPriority Edit] -> ((TableName, Table), (TableName, Table)) -> Diff
    go :: [WithPriority Edit]
-> ((TableName, Table), (TableName, Table)) -> Diff
go [WithPriority Edit]
e ((TableName
hsName, Table
hsTable), (TableName
dbName, Table
dbTable)) = Bool -> Diff -> Diff
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (TableName
hsName TableName -> TableName -> Bool
forall a. Eq a => a -> a -> Bool
== TableName
dbName) (Diff -> Diff) -> Diff -> Diff
forall a b. (a -> b) -> a -> b
$ do
      [WithPriority Edit]
d <- TableName -> Table -> Table -> Diff
diffTableReferenceImplementation TableName
hsName Table
hsTable Table
dbTable
      [WithPriority Edit] -> Diff
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Diff) -> [WithPriority Edit] -> Diff
forall a b. (a -> b) -> a -> b
$ [WithPriority Edit]
e [WithPriority Edit] -> [WithPriority Edit] -> [WithPriority Edit]
forall a. Semigroup a => a -> a -> a
<> [WithPriority Edit]
d

addEdit ::
  (k -> v -> AutomaticEditAction) ->
  (k -> c -> AutomaticEditAction) ->
  (v -> S.Set c) ->
  (k, v) ->
  [WithPriority Edit]
addEdit :: (k -> v -> AutomaticEditAction)
-> (k -> c -> AutomaticEditAction)
-> (v -> Set c)
-> (k, v)
-> [WithPriority Edit]
addEdit k -> v -> AutomaticEditAction
onValue k -> c -> AutomaticEditAction
onConstr v -> Set c
getConstr (k
k, v
v) =
  AutomaticEditAction -> WithPriority Edit
mkEdit (k -> v -> AutomaticEditAction
onValue k
k v
v) WithPriority Edit -> [WithPriority Edit] -> [WithPriority Edit]
forall a. a -> [a] -> [a]
: (c -> WithPriority Edit) -> [c] -> [WithPriority Edit]
forall a b. (a -> b) -> [a] -> [b]
map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (c -> AutomaticEditAction) -> c -> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> c -> AutomaticEditAction
onConstr k
k) (Set c -> [c]
forall a. Set a -> [a]
S.toList (Set c -> [c]) -> Set c -> [c]
forall a b. (a -> b) -> a -> b
$ v -> Set c
getConstr v
v)

diffTableReferenceImplementation :: TableName -> Table -> Table -> Diff
diffTableReferenceImplementation :: TableName -> Table -> Table -> Diff
diffTableReferenceImplementation TableName
tName Table
hsTable Table
dbTable = do
  let constraintsAdded :: Set TableConstraint
constraintsAdded = Set TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => Set a -> Set a -> Set a
S.difference (Table -> Set TableConstraint
tableConstraints Table
hsTable) (Table -> Set TableConstraint
tableConstraints Table
dbTable)
      constraintsRemoved :: Set TableConstraint
constraintsRemoved = Set TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => Set a -> Set a -> Set a
S.difference (Table -> Set TableConstraint
tableConstraints Table
dbTable) (Table -> Set TableConstraint
tableConstraints Table
hsTable)
      columnsAdded :: Map ColumnName Column
columnsAdded = Map ColumnName Column
-> Map ColumnName Column -> Map ColumnName Column
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference (Table -> Map ColumnName Column
tableColumns Table
hsTable) (Table -> Map ColumnName Column
tableColumns Table
dbTable)
      columnsRemoved :: Map ColumnName Column
columnsRemoved = Map ColumnName Column
-> Map ColumnName Column -> Map ColumnName Column
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference (Table -> Map ColumnName Column
tableColumns Table
dbTable) (Table -> Map ColumnName Column
tableColumns Table
hsTable)
      diffableColumns :: Map ColumnName Column
diffableColumns = Map ColumnName Column
-> Map ColumnName Column -> Map ColumnName Column
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.intersection (Table -> Map ColumnName Column
tableColumns Table
hsTable) (Table -> Map ColumnName Column
tableColumns Table
dbTable)
      diffableColumns' :: Map ColumnName Column
diffableColumns' = Map ColumnName Column
-> Map ColumnName Column -> Map ColumnName Column
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.intersection (Table -> Map ColumnName Column
tableColumns Table
dbTable) (Table -> Map ColumnName Column
tableColumns Table
hsTable)
  [WithPriority Edit]
whenBoth <- ([WithPriority Edit]
 -> ((ColumnName, Column), (ColumnName, Column)) -> Diff)
-> [WithPriority Edit]
-> [((ColumnName, Column), (ColumnName, Column))]
-> Diff
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM [WithPriority Edit]
-> ((ColumnName, Column), (ColumnName, Column)) -> Diff
go [WithPriority Edit]
forall a. Monoid a => a
mempty ([(ColumnName, Column)]
-> [(ColumnName, Column)]
-> [((ColumnName, Column), (ColumnName, Column))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map ColumnName Column -> [(ColumnName, Column)]
forall k a. Map k a -> [(k, a)]
M.toList Map ColumnName Column
diffableColumns) (Map ColumnName Column -> [(ColumnName, Column)]
forall k a. Map k a -> [(k, a)]
M.toList Map ColumnName Column
diffableColumns'))
  let tblConstraintsAdded :: Maybe [WithPriority Edit]
tblConstraintsAdded = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set TableConstraint -> Bool
forall a. Set a -> Bool
S.null Set TableConstraint
constraintsAdded)
        [WithPriority Edit] -> Maybe [WithPriority Edit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Maybe [WithPriority Edit])
-> [WithPriority Edit] -> Maybe [WithPriority Edit]
forall a b. (a -> b) -> a -> b
$ (TableConstraint -> WithPriority Edit)
-> [TableConstraint] -> [WithPriority Edit]
forall a b. (a -> b) -> [a] -> [b]
map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (TableConstraint -> AutomaticEditAction)
-> TableConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> TableConstraint -> AutomaticEditAction
TableConstraintAdded TableName
tName) (Set TableConstraint -> [TableConstraint]
forall a. Set a -> [a]
S.toList Set TableConstraint
constraintsAdded)
  let tblConstraintsRemoved :: Maybe [WithPriority Edit]
tblConstraintsRemoved = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set TableConstraint -> Bool
forall a. Set a -> Bool
S.null Set TableConstraint
constraintsRemoved)
        [WithPriority Edit] -> Maybe [WithPriority Edit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Maybe [WithPriority Edit])
-> [WithPriority Edit] -> Maybe [WithPriority Edit]
forall a b. (a -> b) -> a -> b
$ (TableConstraint -> WithPriority Edit)
-> [TableConstraint] -> [WithPriority Edit]
forall a b. (a -> b) -> [a] -> [b]
map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (TableConstraint -> AutomaticEditAction)
-> TableConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> TableConstraint -> AutomaticEditAction
TableConstraintRemoved TableName
tName) (Set TableConstraint -> [TableConstraint]
forall a. Set a -> [a]
S.toList Set TableConstraint
constraintsRemoved)
  let colsAdded :: [WithPriority Edit]
colsAdded = Map ColumnName Column -> [WithPriority Edit]
whenAdded Map ColumnName Column
columnsAdded
  let colsRemoved :: [WithPriority Edit]
colsRemoved = Map ColumnName Column -> [WithPriority Edit]
whenRemoved Map ColumnName Column
columnsRemoved
  [WithPriority Edit] -> Diff
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Diff) -> [WithPriority Edit] -> Diff
forall a b. (a -> b) -> a -> b
$
    [[WithPriority Edit]] -> [WithPriority Edit]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([Maybe [WithPriority Edit]] -> [[WithPriority Edit]]
forall a. [Maybe a] -> [a]
catMaybes [Maybe [WithPriority Edit]
tblConstraintsAdded, Maybe [WithPriority Edit]
tblConstraintsRemoved])
      [WithPriority Edit] -> [WithPriority Edit] -> [WithPriority Edit]
forall a. Semigroup a => a -> a -> a
<> [WithPriority Edit]
colsAdded
      [WithPriority Edit] -> [WithPriority Edit] -> [WithPriority Edit]
forall a. Semigroup a => a -> a -> a
<> [WithPriority Edit]
colsRemoved
      [WithPriority Edit] -> [WithPriority Edit] -> [WithPriority Edit]
forall a. Semigroup a => a -> a -> a
<> [WithPriority Edit]
whenBoth
  where
    go :: [WithPriority Edit] -> ((ColumnName, Column), (ColumnName, Column)) -> Diff
    go :: [WithPriority Edit]
-> ((ColumnName, Column), (ColumnName, Column)) -> Diff
go [WithPriority Edit]
e ((ColumnName
hsName, Column
hsCol), (ColumnName
dbName, Column
dbCol)) = Bool -> Diff -> Diff
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ColumnName
hsName ColumnName -> ColumnName -> Bool
forall a. Eq a => a -> a -> Bool
== ColumnName
dbName) (Diff -> Diff) -> Diff -> Diff
forall a b. (a -> b) -> a -> b
$ do
      [WithPriority Edit]
d <- TableName -> ColumnName -> Column -> Column -> Diff
diffColumnReferenceImplementation TableName
tName ColumnName
hsName Column
hsCol Column
dbCol
      [WithPriority Edit] -> Diff
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Diff) -> [WithPriority Edit] -> Diff
forall a b. (a -> b) -> a -> b
$ [WithPriority Edit]
e [WithPriority Edit] -> [WithPriority Edit] -> [WithPriority Edit]
forall a. Semigroup a => a -> a -> a
<> [WithPriority Edit]
d

    whenAdded :: Columns -> [WithPriority Edit]
    whenAdded :: Map ColumnName Column -> [WithPriority Edit]
whenAdded =
      ((ColumnName, Column) -> [WithPriority Edit])
-> [(ColumnName, Column)] -> [WithPriority Edit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((ColumnName -> Column -> AutomaticEditAction)
-> (ColumnName -> ColumnConstraint -> AutomaticEditAction)
-> (Column -> Set ColumnConstraint)
-> (ColumnName, Column)
-> [WithPriority Edit]
forall k v c.
(k -> v -> AutomaticEditAction)
-> (k -> c -> AutomaticEditAction)
-> (v -> Set c)
-> (k, v)
-> [WithPriority Edit]
addEdit (TableName -> ColumnName -> Column -> AutomaticEditAction
ColumnAdded TableName
tName) (TableName -> ColumnName -> ColumnConstraint -> AutomaticEditAction
ColumnConstraintAdded TableName
tName) Column -> Set ColumnConstraint
columnConstraints) ([(ColumnName, Column)] -> [WithPriority Edit])
-> (Map ColumnName Column -> [(ColumnName, Column)])
-> Map ColumnName Column
-> [WithPriority Edit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ColumnName Column -> [(ColumnName, Column)]
forall k a. Map k a -> [(k, a)]
M.toList

    whenRemoved :: Columns -> [WithPriority Edit]
    whenRemoved :: Map ColumnName Column -> [WithPriority Edit]
whenRemoved =
      ((ColumnName, Column) -> [WithPriority Edit])
-> [(ColumnName, Column)] -> [WithPriority Edit]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((ColumnName -> Column -> AutomaticEditAction)
-> (ColumnName -> ColumnConstraint -> AutomaticEditAction)
-> (Column -> Set ColumnConstraint)
-> (ColumnName, Column)
-> [WithPriority Edit]
forall k v c.
(k -> v -> AutomaticEditAction)
-> (k -> c -> AutomaticEditAction)
-> (v -> Set c)
-> (k, v)
-> [WithPriority Edit]
addEdit (\ColumnName
k Column
_ -> TableName -> ColumnName -> AutomaticEditAction
ColumnRemoved TableName
tName ColumnName
k) (TableName -> ColumnName -> ColumnConstraint -> AutomaticEditAction
ColumnConstraintRemoved TableName
tName) Column -> Set ColumnConstraint
columnConstraints) ([(ColumnName, Column)] -> [WithPriority Edit])
-> (Map ColumnName Column -> [(ColumnName, Column)])
-> Map ColumnName Column
-> [WithPriority Edit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ColumnName Column -> [(ColumnName, Column)]
forall k a. Map k a -> [(k, a)]
M.toList

diffColumnReferenceImplementation :: TableName -> ColumnName -> Column -> Column -> Diff
diffColumnReferenceImplementation :: TableName -> ColumnName -> Column -> Column -> Diff
diffColumnReferenceImplementation TableName
tName ColumnName
colName Column
hsColumn Column
dbColumn = do
  let constraintsAdded :: Set ColumnConstraint
constraintsAdded = Set ColumnConstraint
-> Set ColumnConstraint -> Set ColumnConstraint
forall a. Ord a => Set a -> Set a -> Set a
S.difference (Column -> Set ColumnConstraint
columnConstraints Column
hsColumn) (Column -> Set ColumnConstraint
columnConstraints Column
dbColumn)
      constraintsRemoved :: Set ColumnConstraint
constraintsRemoved = Set ColumnConstraint
-> Set ColumnConstraint -> Set ColumnConstraint
forall a. Ord a => Set a -> Set a -> Set a
S.difference (Column -> Set ColumnConstraint
columnConstraints Column
dbColumn) (Column -> Set ColumnConstraint
columnConstraints Column
hsColumn)
  let colConstraintsAdded :: Maybe [WithPriority Edit]
colConstraintsAdded = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set ColumnConstraint -> Bool
forall a. Set a -> Bool
S.null Set ColumnConstraint
constraintsAdded)
        [WithPriority Edit] -> Maybe [WithPriority Edit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Maybe [WithPriority Edit])
-> [WithPriority Edit] -> Maybe [WithPriority Edit]
forall a b. (a -> b) -> a -> b
$ (ColumnConstraint -> WithPriority Edit)
-> [ColumnConstraint] -> [WithPriority Edit]
forall a b. (a -> b) -> [a] -> [b]
map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (ColumnConstraint -> AutomaticEditAction)
-> ColumnConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> ColumnName -> ColumnConstraint -> AutomaticEditAction
ColumnConstraintAdded TableName
tName ColumnName
colName) (Set ColumnConstraint -> [ColumnConstraint]
forall a. Set a -> [a]
S.toList Set ColumnConstraint
constraintsAdded)
  let colConstraintsRemoved :: Maybe [WithPriority Edit]
colConstraintsRemoved = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set ColumnConstraint -> Bool
forall a. Set a -> Bool
S.null Set ColumnConstraint
constraintsRemoved)
        [WithPriority Edit] -> Maybe [WithPriority Edit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Maybe [WithPriority Edit])
-> [WithPriority Edit] -> Maybe [WithPriority Edit]
forall a b. (a -> b) -> a -> b
$ (ColumnConstraint -> WithPriority Edit)
-> [ColumnConstraint] -> [WithPriority Edit]
forall a b. (a -> b) -> [a] -> [b]
map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (ColumnConstraint -> AutomaticEditAction)
-> ColumnConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> ColumnName -> ColumnConstraint -> AutomaticEditAction
ColumnConstraintRemoved TableName
tName ColumnName
colName) (Set ColumnConstraint -> [ColumnConstraint]
forall a. Set a -> [a]
S.toList Set ColumnConstraint
constraintsRemoved)
  let typeChanged :: Maybe [WithPriority Edit]
typeChanged = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Column -> ColumnType
columnType Column
hsColumn ColumnType -> ColumnType -> Bool
forall a. Eq a => a -> a -> Bool
/= Column -> ColumnType
columnType Column
dbColumn)
        [WithPriority Edit] -> Maybe [WithPriority Edit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction -> WithPriority Edit
forall a b. (a -> b) -> a -> b
$ TableName
-> ColumnName -> ColumnType -> ColumnType -> AutomaticEditAction
ColumnTypeChanged TableName
tName ColumnName
colName (Column -> ColumnType
columnType Column
dbColumn) (Column -> ColumnType
columnType Column
hsColumn)]
  [WithPriority Edit] -> Diff
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WithPriority Edit] -> Diff) -> [WithPriority Edit] -> Diff
forall a b. (a -> b) -> a -> b
$ [[WithPriority Edit]] -> [WithPriority Edit]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[WithPriority Edit]] -> [WithPriority Edit])
-> [[WithPriority Edit]] -> [WithPriority Edit]
forall a b. (a -> b) -> a -> b
$ [Maybe [WithPriority Edit]] -> [[WithPriority Edit]]
forall a. [Maybe a] -> [a]
catMaybes [Maybe [WithPriority Edit]
colConstraintsAdded, Maybe [WithPriority Edit]
colConstraintsRemoved, Maybe [WithPriority Edit]
typeChanged]

--
-- Actual implementation
--

--
-- Diffing enums together
--

diffEnums :: Enumerations -> Enumerations -> DiffA DList
diffEnums :: Enumerations
-> Enumerations -> Either DiffError (DList (WithPriority Edit))
diffEnums Enumerations
hsEnums Enumerations
dbEnums =
  (DList (WithPriority Edit)
 -> DList (WithPriority Edit) -> DList (WithPriority Edit))
-> DList (WithPriority Edit)
-> Map EnumerationName (DList (WithPriority Edit))
-> DList (WithPriority Edit)
forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' DList (WithPriority Edit)
-> DList (WithPriority Edit) -> DList (WithPriority Edit)
forall a. DList a -> DList a -> DList a
D.append DList (WithPriority Edit)
forall a. Monoid a => a
mempty (Map EnumerationName (DList (WithPriority Edit))
 -> DList (WithPriority Edit))
-> Either
     DiffError (Map EnumerationName (DList (WithPriority Edit)))
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing
  (Either DiffError)
  EnumerationName
  Enumeration
  (DList (WithPriority Edit))
-> WhenMissing
     (Either DiffError)
     EnumerationName
     Enumeration
     (DList (WithPriority Edit))
-> WhenMatched
     (Either DiffError)
     EnumerationName
     Enumeration
     Enumeration
     (DList (WithPriority Edit))
-> Enumerations
-> Enumerations
-> Either
     DiffError (Map EnumerationName (DList (WithPriority Edit)))
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
mergeA WhenMissing
  (Either DiffError)
  EnumerationName
  Enumeration
  (DList (WithPriority Edit))
whenEnumsAdded WhenMissing
  (Either DiffError)
  EnumerationName
  Enumeration
  (DList (WithPriority Edit))
whenEnumsRemoved WhenMatched
  (Either DiffError)
  EnumerationName
  Enumeration
  Enumeration
  (DList (WithPriority Edit))
whenBoth Enumerations
hsEnums Enumerations
dbEnums
  where
    whenEnumsAdded :: WhenMissing (Either DiffError) EnumerationName Enumeration (DList (WithPriority Edit))
    whenEnumsAdded :: WhenMissing
  (Either DiffError)
  EnumerationName
  Enumeration
  (DList (WithPriority Edit))
whenEnumsAdded = (EnumerationName
 -> Enumeration -> Either DiffError (DList (WithPriority Edit)))
-> WhenMissing
     (Either DiffError)
     EnumerationName
     Enumeration
     (DList (WithPriority Edit))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing (\EnumerationName
k Enumeration
v -> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. b -> Either a b
Right (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> (AutomaticEditAction -> DList (WithPriority Edit))
-> AutomaticEditAction
-> Either DiffError (DList (WithPriority Edit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithPriority Edit -> DList (WithPriority Edit)
forall a. a -> DList a
D.singleton (WithPriority Edit -> DList (WithPriority Edit))
-> (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction
-> DList (WithPriority Edit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction
 -> Either DiffError (DList (WithPriority Edit)))
-> AutomaticEditAction
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ EnumerationName -> Enumeration -> AutomaticEditAction
EnumTypeAdded EnumerationName
k Enumeration
v)

    whenEnumsRemoved :: WhenMissing (Either DiffError) EnumerationName Enumeration (DList (WithPriority Edit))
    whenEnumsRemoved :: WhenMissing
  (Either DiffError)
  EnumerationName
  Enumeration
  (DList (WithPriority Edit))
whenEnumsRemoved = (EnumerationName
 -> Enumeration -> Either DiffError (DList (WithPriority Edit)))
-> WhenMissing
     (Either DiffError)
     EnumerationName
     Enumeration
     (DList (WithPriority Edit))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing (\EnumerationName
k Enumeration
_ -> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. b -> Either a b
Right (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> (AutomaticEditAction -> DList (WithPriority Edit))
-> AutomaticEditAction
-> Either DiffError (DList (WithPriority Edit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithPriority Edit -> DList (WithPriority Edit)
forall a. a -> DList a
D.singleton (WithPriority Edit -> DList (WithPriority Edit))
-> (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction
-> DList (WithPriority Edit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction
 -> Either DiffError (DList (WithPriority Edit)))
-> AutomaticEditAction
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ EnumerationName -> AutomaticEditAction
EnumTypeRemoved EnumerationName
k)

    whenBoth :: WhenMatched (Either DiffError) EnumerationName Enumeration Enumeration (DList (WithPriority Edit))
    whenBoth :: WhenMatched
  (Either DiffError)
  EnumerationName
  Enumeration
  Enumeration
  (DList (WithPriority Edit))
whenBoth = (EnumerationName
 -> Enumeration
 -> Enumeration
 -> Either DiffError (DList (WithPriority Edit)))
-> WhenMatched
     (Either DiffError)
     EnumerationName
     Enumeration
     Enumeration
     (DList (WithPriority Edit))
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
zipWithAMatched EnumerationName
-> Enumeration
-> Enumeration
-> Either DiffError (DList (WithPriority Edit))
diffEnumeration

diffEnumeration :: EnumerationName -> Enumeration -> Enumeration -> DiffA DList
diffEnumeration :: EnumerationName
-> Enumeration
-> Enumeration
-> Either DiffError (DList (WithPriority Edit))
diffEnumeration EnumerationName
eName (Enumeration [Text]
hsEnum) (Enumeration [Text]
dbEnum) = do
  let valuesRemoved :: [Text]
valuesRemoved = [Text]
dbEnum [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
hsEnum
  if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Text]
valuesRemoved then DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. b -> Either a b
Right (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ [WithPriority Edit] -> DList (WithPriority Edit)
forall a. [a] -> DList a
D.fromList (EnumerationName -> [Text] -> [Text] -> [WithPriority Edit]
computeEnumEdit EnumerationName
eName [Text]
hsEnum [Text]
dbEnum) else DiffError -> Either DiffError (DList (WithPriority Edit))
forall a b. a -> Either a b
Left (DiffError -> Either DiffError (DList (WithPriority Edit)))
-> DiffError -> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ EnumerationName -> [Text] -> DiffError
ValuesRemovedFromEnum EnumerationName
eName [Text]
valuesRemoved

computeEnumEdit :: EnumerationName -> [Text] -> [Text] -> [WithPriority Edit]
computeEnumEdit :: EnumerationName -> [Text] -> [Text] -> [WithPriority Edit]
computeEnumEdit EnumerationName
_ [] [] = [WithPriority Edit]
forall a. Monoid a => a
mempty
computeEnumEdit EnumerationName
_ [] (Text
_ : [Text]
_) = [WithPriority Edit]
forall a. Monoid a => a
mempty
computeEnumEdit EnumerationName
eName (Text
x : [Text]
xs) [] = EnumerationName -> [Text] -> Text -> [WithPriority Edit]
appendAfter EnumerationName
eName [Text]
xs Text
x
computeEnumEdit EnumerationName
eName (Text
x : [Text]
xs) [Text
y] =
  if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
y
    then EnumerationName -> [Text] -> Text -> [WithPriority Edit]
appendAfter EnumerationName
eName [Text]
xs Text
y
    else AutomaticEditAction -> WithPriority Edit
mkEdit (EnumerationName
-> Text -> InsertionOrder -> Text -> AutomaticEditAction
EnumTypeValueAdded EnumerationName
eName Text
x InsertionOrder
Before Text
y) WithPriority Edit -> [WithPriority Edit] -> [WithPriority Edit]
forall a. a -> [a] -> [a]
: EnumerationName -> [Text] -> [Text] -> [WithPriority Edit]
computeEnumEdit EnumerationName
eName [Text]
xs [Text
y]
computeEnumEdit EnumerationName
eName (Text
x : [Text]
xs) (Text
y : [Text]
ys) =
  if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
y
    then EnumerationName -> [Text] -> [Text] -> [WithPriority Edit]
computeEnumEdit EnumerationName
eName [Text]
xs [Text]
ys
    else AutomaticEditAction -> WithPriority Edit
mkEdit (EnumerationName
-> Text -> InsertionOrder -> Text -> AutomaticEditAction
EnumTypeValueAdded EnumerationName
eName Text
x InsertionOrder
Before Text
y) WithPriority Edit -> [WithPriority Edit] -> [WithPriority Edit]
forall a. a -> [a] -> [a]
: EnumerationName -> [Text] -> [Text] -> [WithPriority Edit]
computeEnumEdit EnumerationName
eName [Text]
xs (Text
y Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ys)

appendAfter :: EnumerationName -> [Text] -> Text -> [WithPriority Edit]
appendAfter :: EnumerationName -> [Text] -> Text -> [WithPriority Edit]
appendAfter EnumerationName
_ [] Text
_ = [WithPriority Edit]
forall a. Monoid a => a
mempty
appendAfter EnumerationName
eName [Text
l] Text
z = [AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction -> WithPriority Edit
forall a b. (a -> b) -> a -> b
$ EnumerationName
-> Text -> InsertionOrder -> Text -> AutomaticEditAction
EnumTypeValueAdded EnumerationName
eName Text
l InsertionOrder
After Text
z]
appendAfter EnumerationName
eName (Text
l : [Text]
ls) Text
z = AutomaticEditAction -> WithPriority Edit
mkEdit (EnumerationName
-> Text -> InsertionOrder -> Text -> AutomaticEditAction
EnumTypeValueAdded EnumerationName
eName Text
l InsertionOrder
After Text
z) WithPriority Edit -> [WithPriority Edit] -> [WithPriority Edit]
forall a. a -> [a] -> [a]
: EnumerationName -> [Text] -> Text -> [WithPriority Edit]
appendAfter EnumerationName
eName [Text]
ls Text
l

--
-- Diffing sequences together
--

diffSequences :: Sequences -> Sequences -> DiffA DList
diffSequences :: Sequences
-> Sequences -> Either DiffError (DList (WithPriority Edit))
diffSequences Sequences
hsSeqs Sequences
dbSeqs =
  (DList (WithPriority Edit)
 -> DList (WithPriority Edit) -> DList (WithPriority Edit))
-> DList (WithPriority Edit)
-> Map SequenceName (DList (WithPriority Edit))
-> DList (WithPriority Edit)
forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' DList (WithPriority Edit)
-> DList (WithPriority Edit) -> DList (WithPriority Edit)
forall a. DList a -> DList a -> DList a
D.append DList (WithPriority Edit)
forall a. Monoid a => a
mempty (Map SequenceName (DList (WithPriority Edit))
 -> DList (WithPriority Edit))
-> Either DiffError (Map SequenceName (DList (WithPriority Edit)))
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing
  (Either DiffError)
  SequenceName
  Sequence
  (DList (WithPriority Edit))
-> WhenMissing
     (Either DiffError)
     SequenceName
     Sequence
     (DList (WithPriority Edit))
-> WhenMatched
     (Either DiffError)
     SequenceName
     Sequence
     Sequence
     (DList (WithPriority Edit))
-> Sequences
-> Sequences
-> Either DiffError (Map SequenceName (DList (WithPriority Edit)))
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
mergeA WhenMissing
  (Either DiffError)
  SequenceName
  Sequence
  (DList (WithPriority Edit))
whenSeqsAdded WhenMissing
  (Either DiffError)
  SequenceName
  Sequence
  (DList (WithPriority Edit))
whenSeqsRemoved WhenMatched
  (Either DiffError)
  SequenceName
  Sequence
  Sequence
  (DList (WithPriority Edit))
whenBoth Sequences
hsSeqs Sequences
dbSeqs
  where
    whenSeqsAdded :: WhenMissing (Either DiffError) SequenceName Sequence (DList (WithPriority Edit))
    whenSeqsAdded :: WhenMissing
  (Either DiffError)
  SequenceName
  Sequence
  (DList (WithPriority Edit))
whenSeqsAdded = (SequenceName
 -> Sequence -> Either DiffError (DList (WithPriority Edit)))
-> WhenMissing
     (Either DiffError)
     SequenceName
     Sequence
     (DList (WithPriority Edit))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing (\SequenceName
k Sequence
v -> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. b -> Either a b
Right (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> (AutomaticEditAction -> DList (WithPriority Edit))
-> AutomaticEditAction
-> Either DiffError (DList (WithPriority Edit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithPriority Edit -> DList (WithPriority Edit)
forall a. a -> DList a
D.singleton (WithPriority Edit -> DList (WithPriority Edit))
-> (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction
-> DList (WithPriority Edit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction
 -> Either DiffError (DList (WithPriority Edit)))
-> AutomaticEditAction
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ SequenceName -> Sequence -> AutomaticEditAction
SequenceAdded SequenceName
k Sequence
v)

    whenSeqsRemoved :: WhenMissing (Either DiffError) SequenceName Sequence (DList (WithPriority Edit))
    whenSeqsRemoved :: WhenMissing
  (Either DiffError)
  SequenceName
  Sequence
  (DList (WithPriority Edit))
whenSeqsRemoved = (SequenceName
 -> Sequence -> Either DiffError (DList (WithPriority Edit)))
-> WhenMissing
     (Either DiffError)
     SequenceName
     Sequence
     (DList (WithPriority Edit))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing (\SequenceName
k Sequence
_ -> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. b -> Either a b
Right (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> (AutomaticEditAction -> DList (WithPriority Edit))
-> AutomaticEditAction
-> Either DiffError (DList (WithPriority Edit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithPriority Edit -> DList (WithPriority Edit)
forall a. a -> DList a
D.singleton (WithPriority Edit -> DList (WithPriority Edit))
-> (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction
-> DList (WithPriority Edit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction
 -> Either DiffError (DList (WithPriority Edit)))
-> AutomaticEditAction
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ SequenceName -> AutomaticEditAction
SequenceRemoved SequenceName
k)

    -- Currently a 'Sequence' doesn't carry any extra information, so diffing two 'Sequence's is
    -- a no-op, basically.
    whenBoth :: WhenMatched (Either DiffError) SequenceName Sequence Sequence (DList (WithPriority Edit))
    whenBoth :: WhenMatched
  (Either DiffError)
  SequenceName
  Sequence
  Sequence
  (DList (WithPriority Edit))
whenBoth = (SequenceName
 -> Sequence
 -> Sequence
 -> Either DiffError (DList (WithPriority Edit)))
-> WhenMatched
     (Either DiffError)
     SequenceName
     Sequence
     Sequence
     (DList (WithPriority Edit))
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
zipWithAMatched (\SequenceName
_ (Sequence TableName
_ ColumnName
_) (Sequence TableName
_ ColumnName
_) -> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. b -> Either a b
Right DList (WithPriority Edit)
forall a. Monoid a => a
mempty)

--
-- Diffing tables together
--

diffTables :: Tables -> Tables -> DiffA DList
diffTables :: Tables -> Tables -> Either DiffError (DList (WithPriority Edit))
diffTables Tables
hsTables Tables
dbTables =
  (DList (WithPriority Edit)
 -> DList (WithPriority Edit) -> DList (WithPriority Edit))
-> DList (WithPriority Edit)
-> Map TableName (DList (WithPriority Edit))
-> DList (WithPriority Edit)
forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' DList (WithPriority Edit)
-> DList (WithPriority Edit) -> DList (WithPriority Edit)
forall a. DList a -> DList a -> DList a
D.append DList (WithPriority Edit)
forall a. Monoid a => a
mempty (Map TableName (DList (WithPriority Edit))
 -> DList (WithPriority Edit))
-> Either DiffError (Map TableName (DList (WithPriority Edit)))
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing
  (Either DiffError) TableName Table (DList (WithPriority Edit))
-> WhenMissing
     (Either DiffError) TableName Table (DList (WithPriority Edit))
-> WhenMatched
     (Either DiffError)
     TableName
     Table
     Table
     (DList (WithPriority Edit))
-> Tables
-> Tables
-> Either DiffError (Map TableName (DList (WithPriority Edit)))
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
mergeA WhenMissing
  (Either DiffError) TableName Table (DList (WithPriority Edit))
whenTablesAdded WhenMissing
  (Either DiffError) TableName Table (DList (WithPriority Edit))
whenTablesRemoved WhenMatched
  (Either DiffError)
  TableName
  Table
  Table
  (DList (WithPriority Edit))
whenBoth Tables
hsTables Tables
dbTables
  where
    whenTablesAdded :: WhenMissing (Either DiffError) TableName Table (DList (WithPriority Edit))
    whenTablesAdded :: WhenMissing
  (Either DiffError) TableName Table (DList (WithPriority Edit))
whenTablesAdded =
      (TableName
 -> Table -> Either DiffError (DList (WithPriority Edit)))
-> WhenMissing
     (Either DiffError) TableName Table (DList (WithPriority Edit))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing
        ( \TableName
k Table
v -> do
            let created :: WithPriority Edit
created = AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction -> WithPriority Edit
forall a b. (a -> b) -> a -> b
$ TableName -> Table -> AutomaticEditAction
TableAdded TableName
k Table
v
            let constraintsAdded :: [WithPriority Edit]
constraintsAdded = (TableConstraint -> WithPriority Edit)
-> [TableConstraint] -> [WithPriority Edit]
forall a b. (a -> b) -> [a] -> [b]
map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (TableConstraint -> AutomaticEditAction)
-> TableConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> TableConstraint -> AutomaticEditAction
TableConstraintAdded TableName
k) (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
v)
            DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ [WithPriority Edit] -> DList (WithPriority Edit)
forall a. [a] -> DList a
D.fromList (WithPriority Edit
created WithPriority Edit -> [WithPriority Edit] -> [WithPriority Edit]
forall a. a -> [a] -> [a]
: [WithPriority Edit]
constraintsAdded)
        )

    whenTablesRemoved :: WhenMissing (Either DiffError) TableName Table (DList (WithPriority Edit))
    whenTablesRemoved :: WhenMissing
  (Either DiffError) TableName Table (DList (WithPriority Edit))
whenTablesRemoved =
      (TableName
 -> Table -> Either DiffError (DList (WithPriority Edit)))
-> WhenMissing
     (Either DiffError) TableName Table (DList (WithPriority Edit))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing
        ( \TableName
k Table
v -> do
            let removed :: WithPriority Edit
removed = AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction -> WithPriority Edit
forall a b. (a -> b) -> a -> b
$ TableName -> AutomaticEditAction
TableRemoved TableName
k
            let constraintsRemoved :: [WithPriority Edit]
constraintsRemoved = (TableConstraint -> WithPriority Edit)
-> [TableConstraint] -> [WithPriority Edit]
forall a b. (a -> b) -> [a] -> [b]
map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (TableConstraint -> AutomaticEditAction)
-> TableConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> TableConstraint -> AutomaticEditAction
TableConstraintRemoved TableName
k) (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
v)
            DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ [WithPriority Edit] -> DList (WithPriority Edit)
forall a. [a] -> DList a
D.fromList (WithPriority Edit
removed WithPriority Edit -> [WithPriority Edit] -> [WithPriority Edit]
forall a. a -> [a] -> [a]
: [WithPriority Edit]
constraintsRemoved)
        )

    whenBoth :: WhenMatched (Either DiffError) TableName Table Table (DList (WithPriority Edit))
    whenBoth :: WhenMatched
  (Either DiffError)
  TableName
  Table
  Table
  (DList (WithPriority Edit))
whenBoth = (TableName
 -> Table -> Table -> Either DiffError (DList (WithPriority Edit)))
-> WhenMatched
     (Either DiffError)
     TableName
     Table
     Table
     (DList (WithPriority Edit))
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
zipWithAMatched TableName
-> Table -> Table -> Either DiffError (DList (WithPriority Edit))
diffTable

diffTable :: TableName -> Table -> Table -> DiffA DList
diffTable :: TableName
-> Table -> Table -> Either DiffError (DList (WithPriority Edit))
diffTable TableName
tName Table
hsTable Table
dbTable = do
  let constraintsAdded :: Set TableConstraint
constraintsAdded = Set TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => Set a -> Set a -> Set a
S.difference (Table -> Set TableConstraint
tableConstraints Table
hsTable) (Table -> Set TableConstraint
tableConstraints Table
dbTable)
      constraintsRemoved :: Set TableConstraint
constraintsRemoved = Set TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => Set a -> Set a -> Set a
S.difference (Table -> Set TableConstraint
tableConstraints Table
dbTable) (Table -> Set TableConstraint
tableConstraints Table
hsTable)
      tblConstraintsAdded :: Maybe (DList (WithPriority Edit))
tblConstraintsAdded = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set TableConstraint -> Bool
forall a. Set a -> Bool
S.null Set TableConstraint
constraintsAdded)
        DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit)))
-> DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ (TableConstraint -> WithPriority Edit)
-> DList TableConstraint -> DList (WithPriority Edit)
forall a b. (a -> b) -> DList a -> DList b
D.map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (TableConstraint -> AutomaticEditAction)
-> TableConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> TableConstraint -> AutomaticEditAction
TableConstraintAdded TableName
tName) ([TableConstraint] -> DList TableConstraint
forall a. [a] -> DList a
D.fromList ([TableConstraint] -> DList TableConstraint)
-> (Set TableConstraint -> [TableConstraint])
-> Set TableConstraint
-> DList TableConstraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TableConstraint -> [TableConstraint]
forall a. Set a -> [a]
S.toList (Set TableConstraint -> DList TableConstraint)
-> Set TableConstraint -> DList TableConstraint
forall a b. (a -> b) -> a -> b
$ Set TableConstraint
constraintsAdded)
      tblConstraintsRemoved :: Maybe (DList (WithPriority Edit))
tblConstraintsRemoved = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set TableConstraint -> Bool
forall a. Set a -> Bool
S.null Set TableConstraint
constraintsRemoved)
        DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit)))
-> DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ (TableConstraint -> WithPriority Edit)
-> DList TableConstraint -> DList (WithPriority Edit)
forall a b. (a -> b) -> DList a -> DList b
D.map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (TableConstraint -> AutomaticEditAction)
-> TableConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> TableConstraint -> AutomaticEditAction
TableConstraintRemoved TableName
tName) ([TableConstraint] -> DList TableConstraint
forall a. [a] -> DList a
D.fromList ([TableConstraint] -> DList TableConstraint)
-> (Set TableConstraint -> [TableConstraint])
-> Set TableConstraint
-> DList TableConstraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TableConstraint -> [TableConstraint]
forall a. Set a -> [a]
S.toList (Set TableConstraint -> DList TableConstraint)
-> Set TableConstraint -> DList TableConstraint
forall a b. (a -> b) -> a -> b
$ Set TableConstraint
constraintsRemoved)
  DList (WithPriority Edit)
diffs <-
    (DList (WithPriority Edit)
 -> DList (WithPriority Edit) -> DList (WithPriority Edit))
-> DList (WithPriority Edit)
-> Map ColumnName (DList (WithPriority Edit))
-> DList (WithPriority Edit)
forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' DList (WithPriority Edit)
-> DList (WithPriority Edit) -> DList (WithPriority Edit)
forall a. DList a -> DList a -> DList a
D.append DList (WithPriority Edit)
forall a. Monoid a => a
mempty
      (Map ColumnName (DList (WithPriority Edit))
 -> DList (WithPriority Edit))
-> Either DiffError (Map ColumnName (DList (WithPriority Edit)))
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing
  (Either DiffError) ColumnName Column (DList (WithPriority Edit))
-> WhenMissing
     (Either DiffError) ColumnName Column (DList (WithPriority Edit))
-> WhenMatched
     (Either DiffError)
     ColumnName
     Column
     Column
     (DList (WithPriority Edit))
-> Map ColumnName Column
-> Map ColumnName Column
-> Either DiffError (Map ColumnName (DList (WithPriority Edit)))
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
mergeA WhenMissing
  (Either DiffError) ColumnName Column (DList (WithPriority Edit))
whenColumnAdded WhenMissing
  (Either DiffError) ColumnName Column (DList (WithPriority Edit))
whenColumnRemoved WhenMatched
  (Either DiffError)
  ColumnName
  Column
  Column
  (DList (WithPriority Edit))
whenBoth (Table -> Map ColumnName Column
tableColumns Table
hsTable) (Table -> Map ColumnName Column
tableColumns Table
dbTable)
  DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ (DList (WithPriority Edit)
 -> DList (WithPriority Edit) -> DList (WithPriority Edit))
-> DList (WithPriority Edit)
-> [DList (WithPriority Edit)]
-> DList (WithPriority Edit)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DList (WithPriority Edit)
-> DList (WithPriority Edit) -> DList (WithPriority Edit)
forall a. DList a -> DList a -> DList a
D.append DList (WithPriority Edit)
forall a. DList a
D.empty ([Maybe (DList (WithPriority Edit))] -> [DList (WithPriority Edit)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (DList (WithPriority Edit))
tblConstraintsAdded, Maybe (DList (WithPriority Edit))
tblConstraintsRemoved]) DList (WithPriority Edit)
-> DList (WithPriority Edit) -> DList (WithPriority Edit)
forall a. Semigroup a => a -> a -> a
<> DList (WithPriority Edit)
diffs
  where
    whenColumnAdded :: WhenMissing (Either DiffError) ColumnName Column (DList (WithPriority Edit))
    whenColumnAdded :: WhenMissing
  (Either DiffError) ColumnName Column (DList (WithPriority Edit))
whenColumnAdded =
      (ColumnName
 -> Column -> Either DiffError (DList (WithPriority Edit)))
-> WhenMissing
     (Either DiffError) ColumnName Column (DList (WithPriority Edit))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing
        ( \ColumnName
k Column
v -> do
            let added :: WithPriority Edit
added = AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction -> WithPriority Edit
forall a b. (a -> b) -> a -> b
$ TableName -> ColumnName -> Column -> AutomaticEditAction
ColumnAdded TableName
tName ColumnName
k Column
v
            let constraintsAdded :: [WithPriority Edit]
constraintsAdded = (ColumnConstraint -> WithPriority Edit)
-> [ColumnConstraint] -> [WithPriority Edit]
forall a b. (a -> b) -> [a] -> [b]
map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (ColumnConstraint -> AutomaticEditAction)
-> ColumnConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> ColumnName -> ColumnConstraint -> AutomaticEditAction
ColumnConstraintAdded TableName
tName ColumnName
k) (Set ColumnConstraint -> [ColumnConstraint]
forall a. Set a -> [a]
S.toList (Set ColumnConstraint -> [ColumnConstraint])
-> Set ColumnConstraint -> [ColumnConstraint]
forall a b. (a -> b) -> a -> b
$ Column -> Set ColumnConstraint
columnConstraints Column
v)
            DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ [WithPriority Edit] -> DList (WithPriority Edit)
forall a. [a] -> DList a
D.fromList (WithPriority Edit
added WithPriority Edit -> [WithPriority Edit] -> [WithPriority Edit]
forall a. a -> [a] -> [a]
: [WithPriority Edit]
constraintsAdded)
        )

    whenColumnRemoved :: WhenMissing (Either DiffError) ColumnName Column (DList (WithPriority Edit))
    whenColumnRemoved :: WhenMissing
  (Either DiffError) ColumnName Column (DList (WithPriority Edit))
whenColumnRemoved =
      (ColumnName
 -> Column -> Either DiffError (DList (WithPriority Edit)))
-> WhenMissing
     (Either DiffError) ColumnName Column (DList (WithPriority Edit))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing
        ( \ColumnName
k Column
v -> do
            let removed :: WithPriority Edit
removed = AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction -> WithPriority Edit
forall a b. (a -> b) -> a -> b
$ TableName -> ColumnName -> AutomaticEditAction
ColumnRemoved TableName
tName ColumnName
k
            let constraintsRemoved :: [WithPriority Edit]
constraintsRemoved = (ColumnConstraint -> WithPriority Edit)
-> [ColumnConstraint] -> [WithPriority Edit]
forall a b. (a -> b) -> [a] -> [b]
map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (ColumnConstraint -> AutomaticEditAction)
-> ColumnConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> ColumnName -> ColumnConstraint -> AutomaticEditAction
ColumnConstraintRemoved TableName
tName ColumnName
k) (Set ColumnConstraint -> [ColumnConstraint]
forall a. Set a -> [a]
S.toList (Set ColumnConstraint -> [ColumnConstraint])
-> Set ColumnConstraint -> [ColumnConstraint]
forall a b. (a -> b) -> a -> b
$ Column -> Set ColumnConstraint
columnConstraints Column
v)
            DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ [WithPriority Edit] -> DList (WithPriority Edit)
forall a. [a] -> DList a
D.fromList (WithPriority Edit
removed WithPriority Edit -> [WithPriority Edit] -> [WithPriority Edit]
forall a. a -> [a] -> [a]
: [WithPriority Edit]
constraintsRemoved)
        )

    whenBoth :: WhenMatched (Either DiffError) ColumnName Column Column (DList (WithPriority Edit))
    whenBoth :: WhenMatched
  (Either DiffError)
  ColumnName
  Column
  Column
  (DList (WithPriority Edit))
whenBoth = (ColumnName
 -> Column
 -> Column
 -> Either DiffError (DList (WithPriority Edit)))
-> WhenMatched
     (Either DiffError)
     ColumnName
     Column
     Column
     (DList (WithPriority Edit))
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
zipWithAMatched (TableName
-> ColumnName
-> Column
-> Column
-> Either DiffError (DList (WithPriority Edit))
diffColumn TableName
tName)

diffColumn :: TableName -> ColumnName -> Column -> Column -> DiffA DList
diffColumn :: TableName
-> ColumnName
-> Column
-> Column
-> Either DiffError (DList (WithPriority Edit))
diffColumn TableName
tName ColumnName
colName Column
hsColumn Column
dbColumn = do
  let constraintsAdded :: Set ColumnConstraint
constraintsAdded = Set ColumnConstraint
-> Set ColumnConstraint -> Set ColumnConstraint
forall a. Ord a => Set a -> Set a -> Set a
S.difference (Column -> Set ColumnConstraint
columnConstraints Column
hsColumn) (Column -> Set ColumnConstraint
columnConstraints Column
dbColumn)
      constraintsRemoved :: Set ColumnConstraint
constraintsRemoved = Set ColumnConstraint
-> Set ColumnConstraint -> Set ColumnConstraint
forall a. Ord a => Set a -> Set a -> Set a
S.difference (Column -> Set ColumnConstraint
columnConstraints Column
dbColumn) (Column -> Set ColumnConstraint
columnConstraints Column
hsColumn)
  let colConstraintsAdded :: Maybe (DList (WithPriority Edit))
colConstraintsAdded = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set ColumnConstraint -> Bool
forall a. Set a -> Bool
S.null Set ColumnConstraint
constraintsAdded)
        DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit)))
-> DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ (ColumnConstraint -> WithPriority Edit)
-> DList ColumnConstraint -> DList (WithPriority Edit)
forall a b. (a -> b) -> DList a -> DList b
D.map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (ColumnConstraint -> AutomaticEditAction)
-> ColumnConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> ColumnName -> ColumnConstraint -> AutomaticEditAction
ColumnConstraintAdded TableName
tName ColumnName
colName) ([ColumnConstraint] -> DList ColumnConstraint
forall a. [a] -> DList a
D.fromList ([ColumnConstraint] -> DList ColumnConstraint)
-> (Set ColumnConstraint -> [ColumnConstraint])
-> Set ColumnConstraint
-> DList ColumnConstraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ColumnConstraint -> [ColumnConstraint]
forall a. Set a -> [a]
S.toList (Set ColumnConstraint -> DList ColumnConstraint)
-> Set ColumnConstraint -> DList ColumnConstraint
forall a b. (a -> b) -> a -> b
$ Set ColumnConstraint
constraintsAdded)
  let colConstraintsRemoved :: Maybe (DList (WithPriority Edit))
colConstraintsRemoved = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set ColumnConstraint -> Bool
forall a. Set a -> Bool
S.null Set ColumnConstraint
constraintsRemoved)
        DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit)))
-> DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ (ColumnConstraint -> WithPriority Edit)
-> DList ColumnConstraint -> DList (WithPriority Edit)
forall a b. (a -> b) -> DList a -> DList b
D.map (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> (ColumnConstraint -> AutomaticEditAction)
-> ColumnConstraint
-> WithPriority Edit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> ColumnName -> ColumnConstraint -> AutomaticEditAction
ColumnConstraintRemoved TableName
tName ColumnName
colName) ([ColumnConstraint] -> DList ColumnConstraint
forall a. [a] -> DList a
D.fromList ([ColumnConstraint] -> DList ColumnConstraint)
-> (Set ColumnConstraint -> [ColumnConstraint])
-> Set ColumnConstraint
-> DList ColumnConstraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ColumnConstraint -> [ColumnConstraint]
forall a. Set a -> [a]
S.toList (Set ColumnConstraint -> DList ColumnConstraint)
-> Set ColumnConstraint -> DList ColumnConstraint
forall a b. (a -> b) -> a -> b
$ Set ColumnConstraint
constraintsRemoved)
  let typeChanged :: Maybe (DList (WithPriority Edit))
typeChanged = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Column -> ColumnType
columnType Column
hsColumn ColumnType -> ColumnType -> Bool
forall a. Eq a => a -> a -> Bool
/= Column -> ColumnType
columnType Column
dbColumn)
        DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit)))
-> DList (WithPriority Edit) -> Maybe (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ WithPriority Edit -> DList (WithPriority Edit)
forall a. a -> DList a
D.singleton (AutomaticEditAction -> WithPriority Edit
mkEdit (AutomaticEditAction -> WithPriority Edit)
-> AutomaticEditAction -> WithPriority Edit
forall a b. (a -> b) -> a -> b
$ TableName
-> ColumnName -> ColumnType -> ColumnType -> AutomaticEditAction
ColumnTypeChanged TableName
tName ColumnName
colName (Column -> ColumnType
columnType Column
dbColumn) (Column -> ColumnType
columnType Column
hsColumn))
  DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList (WithPriority Edit)
 -> Either DiffError (DList (WithPriority Edit)))
-> DList (WithPriority Edit)
-> Either DiffError (DList (WithPriority Edit))
forall a b. (a -> b) -> a -> b
$ (DList (WithPriority Edit)
 -> DList (WithPriority Edit) -> DList (WithPriority Edit))
-> DList (WithPriority Edit)
-> [DList (WithPriority Edit)]
-> DList (WithPriority Edit)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DList (WithPriority Edit)
-> DList (WithPriority Edit) -> DList (WithPriority Edit)
forall a. DList a -> DList a -> DList a
D.append DList (WithPriority Edit)
forall a. DList a
D.empty ([DList (WithPriority Edit)] -> DList (WithPriority Edit))
-> [DList (WithPriority Edit)] -> DList (WithPriority Edit)
forall a b. (a -> b) -> a -> b
$ [Maybe (DList (WithPriority Edit))] -> [DList (WithPriority Edit)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (DList (WithPriority Edit))
colConstraintsAdded, Maybe (DList (WithPriority Edit))
colConstraintsRemoved, Maybe (DList (WithPriority Edit))
typeChanged]