{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}

{-|
Copyright: © 2021-2023 IOHK, 2024 Cardano Foundation
License: Apache-2.0

Delta types for 'Set'.
-}
module Data.Delta.Set
    ( -- * Single element
      DeltaSet1 (..)
    -- $DeltaSet1-laws

    -- * Multiple elements
    , DeltaSet
    , diffSet
    , listFromDeltaSet
    , deltaSetFromList
    ) where

import Prelude

import Data.Delta.Core
    ( Delta (..)
    )
import Data.Set
    ( Set
    )

import qualified Data.Set as Set

{-------------------------------------------------------------------------------
    DeltaSet
-------------------------------------------------------------------------------}

-- | Delta type for 'Set' where a single element is deleted or added.
data DeltaSet1 a
    = Insert a
    | Delete a
    deriving (DeltaSet1 a -> DeltaSet1 a -> Bool
(DeltaSet1 a -> DeltaSet1 a -> Bool)
-> (DeltaSet1 a -> DeltaSet1 a -> Bool) -> Eq (DeltaSet1 a)
forall a. Eq a => DeltaSet1 a -> DeltaSet1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => DeltaSet1 a -> DeltaSet1 a -> Bool
== :: DeltaSet1 a -> DeltaSet1 a -> Bool
$c/= :: forall a. Eq a => DeltaSet1 a -> DeltaSet1 a -> Bool
/= :: DeltaSet1 a -> DeltaSet1 a -> Bool
Eq, Eq (DeltaSet1 a)
Eq (DeltaSet1 a) =>
(DeltaSet1 a -> DeltaSet1 a -> Ordering)
-> (DeltaSet1 a -> DeltaSet1 a -> Bool)
-> (DeltaSet1 a -> DeltaSet1 a -> Bool)
-> (DeltaSet1 a -> DeltaSet1 a -> Bool)
-> (DeltaSet1 a -> DeltaSet1 a -> Bool)
-> (DeltaSet1 a -> DeltaSet1 a -> DeltaSet1 a)
-> (DeltaSet1 a -> DeltaSet1 a -> DeltaSet1 a)
-> Ord (DeltaSet1 a)
DeltaSet1 a -> DeltaSet1 a -> Bool
DeltaSet1 a -> DeltaSet1 a -> Ordering
DeltaSet1 a -> DeltaSet1 a -> DeltaSet1 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 (DeltaSet1 a)
forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> Bool
forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> Ordering
forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> DeltaSet1 a
$ccompare :: forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> Ordering
compare :: DeltaSet1 a -> DeltaSet1 a -> Ordering
$c< :: forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> Bool
< :: DeltaSet1 a -> DeltaSet1 a -> Bool
$c<= :: forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> Bool
<= :: DeltaSet1 a -> DeltaSet1 a -> Bool
$c> :: forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> Bool
> :: DeltaSet1 a -> DeltaSet1 a -> Bool
$c>= :: forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> Bool
>= :: DeltaSet1 a -> DeltaSet1 a -> Bool
$cmax :: forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> DeltaSet1 a
max :: DeltaSet1 a -> DeltaSet1 a -> DeltaSet1 a
$cmin :: forall a. Ord a => DeltaSet1 a -> DeltaSet1 a -> DeltaSet1 a
min :: DeltaSet1 a -> DeltaSet1 a -> DeltaSet1 a
Ord, Int -> DeltaSet1 a -> ShowS
[DeltaSet1 a] -> ShowS
DeltaSet1 a -> String
(Int -> DeltaSet1 a -> ShowS)
-> (DeltaSet1 a -> String)
-> ([DeltaSet1 a] -> ShowS)
-> Show (DeltaSet1 a)
forall a. Show a => Int -> DeltaSet1 a -> ShowS
forall a. Show a => [DeltaSet1 a] -> ShowS
forall a. Show a => DeltaSet1 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DeltaSet1 a -> ShowS
showsPrec :: Int -> DeltaSet1 a -> ShowS
$cshow :: forall a. Show a => DeltaSet1 a -> String
show :: DeltaSet1 a -> String
$cshowList :: forall a. Show a => [DeltaSet1 a] -> ShowS
showList :: [DeltaSet1 a] -> ShowS
Show)

instance Ord a => Delta (DeltaSet1 a) where
    type Base (DeltaSet1 a) = Set a
    apply :: DeltaSet1 a -> Base (DeltaSet1 a) -> Base (DeltaSet1 a)
apply (Insert a
a) = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
a
    apply (Delete a
a) = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
a

-- | Delta type for a 'Set' where
-- collections of elements are inserted or deleted.
data DeltaSet a = DeltaSet
    { forall a. DeltaSet a -> Set a
inserts :: Set a
    , forall a. DeltaSet a -> Set a
deletes :: Set a
    -- INVARIANT: The two sets are always disjoint.
    }
    deriving (DeltaSet a -> DeltaSet a -> Bool
(DeltaSet a -> DeltaSet a -> Bool)
-> (DeltaSet a -> DeltaSet a -> Bool) -> Eq (DeltaSet a)
forall a. Eq a => DeltaSet a -> DeltaSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => DeltaSet a -> DeltaSet a -> Bool
== :: DeltaSet a -> DeltaSet a -> Bool
$c/= :: forall a. Eq a => DeltaSet a -> DeltaSet a -> Bool
/= :: DeltaSet a -> DeltaSet a -> Bool
Eq)

instance Ord a => Delta (DeltaSet a) where
    type Base (DeltaSet a) = Set a
    apply :: DeltaSet a -> Base (DeltaSet a) -> Base (DeltaSet a)
apply (DeltaSet Set a
i Set a
d) Base (DeltaSet a)
x = Set a
i Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (Set a
Base (DeltaSet a)
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set a
d)

-- | The smallest delta that changes the second argument to the first argument.
--
-- prop> new = apply (diffSet new old) old
-- prop> diffSet (Set.fromList "ac") (Set.fromList "ab") = deltaSetFromList [Insert 'c', Delete 'b']
diffSet :: Ord a => Set a -> Set a -> DeltaSet a
diffSet :: forall a. Ord a => Set a -> Set a -> DeltaSet a
diffSet Set a
new Set a
old =
    DeltaSet
        { inserts :: Set a
inserts = Set a
new Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set a
old
        , deletes :: Set a
deletes = Set a
old Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set a
new
        }

-- | Flatten a 'DeltaSet' to a list of 'DeltaSet1'.
--
-- In the result list, the set of @a@ appearing as 'Insert'@ a@
-- is /disjoint/ from the set of @a@ appearing as 'Delete'@ a@.
listFromDeltaSet :: DeltaSet a -> [DeltaSet1 a]
listFromDeltaSet :: forall a. DeltaSet a -> [DeltaSet1 a]
listFromDeltaSet DeltaSet{Set a
inserts :: forall a. DeltaSet a -> Set a
inserts :: Set a
inserts,Set a
deletes :: forall a. DeltaSet a -> Set a
deletes :: Set a
deletes} =
    (a -> DeltaSet1 a) -> [a] -> [DeltaSet1 a]
forall a b. (a -> b) -> [a] -> [b]
map a -> DeltaSet1 a
forall a. a -> DeltaSet1 a
Insert (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
inserts) [DeltaSet1 a] -> [DeltaSet1 a] -> [DeltaSet1 a]
forall a. Semigroup a => a -> a -> a
<> (a -> DeltaSet1 a) -> [a] -> [DeltaSet1 a]
forall a b. (a -> b) -> [a] -> [b]
map a -> DeltaSet1 a
forall a. a -> DeltaSet1 a
Delete (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
deletes)

-- | Collect insertions or deletions of elements into a 'DeltaSet'.
--
-- To save space, combinations of 'Insert' and 'Delete'
-- for the same element are simplified when possible.
-- These simplifications always preserve the property
--
-- prop> apply (deltaSetFromList ds) = apply ds
deltaSetFromList :: Ord a => [DeltaSet1 a] -> DeltaSet a
deltaSetFromList :: forall a. Ord a => [DeltaSet1 a] -> DeltaSet a
deltaSetFromList = (DeltaSet1 a -> DeltaSet a -> DeltaSet a)
-> DeltaSet a -> [DeltaSet1 a] -> DeltaSet a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DeltaSet1 a -> DeltaSet a -> DeltaSet a
forall {a}. Ord a => DeltaSet1 a -> DeltaSet a -> DeltaSet a
step DeltaSet a
forall {a}. DeltaSet a
empty
  where
    empty :: DeltaSet a
empty = Set a -> Set a -> DeltaSet a
forall a. Set a -> Set a -> DeltaSet a
DeltaSet Set a
forall a. Set a
Set.empty Set a
forall a. Set a
Set.empty
    step :: DeltaSet1 a -> DeltaSet a -> DeltaSet a
step (Insert a
a) (DeltaSet Set a
i Set a
d) = Set a -> Set a -> DeltaSet a
forall a. Set a -> Set a -> DeltaSet a
DeltaSet (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
a Set a
i) (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
a Set a
d)
    step (Delete a
a) (DeltaSet Set a
i Set a
d) = Set a -> Set a -> DeltaSet a
forall a. Set a -> Set a -> DeltaSet a
DeltaSet (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
a Set a
i) (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
a Set a
d)

-- Note [DeltaSet1 Laws]
{-$DeltaSet1-laws

The following cancellation laws hold:

prop> apply [Insert a, Delete a] = apply (Insert a)
prop> apply [Insert a, Insert a] = apply (Insert a)
prop> apply [Delete a, Insert a] = apply (Delete a)
prop> apply [Delete a, Delete a] = apply (Delete a)

-}

-- | Remember that the semigroup instance is required to satisfy
-- the following properties:
--
-- prop> apply mempty = id
-- prop> apply (d1 <> d2) = apply d1 . apply d2
instance Ord a => Semigroup (DeltaSet a) where
    (DeltaSet Set a
i1 Set a
d1) <> :: DeltaSet a -> DeltaSet a -> DeltaSet a
<> (DeltaSet Set a
i2 Set a
d2) = Set a -> Set a -> DeltaSet a
forall a. Set a -> Set a -> DeltaSet a
DeltaSet
        (Set a
i1 Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (Set a
i2 Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set a
d1))
        (Set a
d1 Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (Set a
d2 Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set a
i1))
        -- This takes into account [DeltaSet1 Cancellations]

instance Ord a => Monoid (DeltaSet a) where
    mempty :: DeltaSet a
mempty = Set a -> Set a -> DeltaSet a
forall a. Set a -> Set a -> DeltaSet a
DeltaSet Set a
forall a. Set a
Set.empty Set a
forall a. Set a
Set.empty