Add tests for basic delta types

lib/delta-types/delta-types.cabal

@@ -85,7 +85,12 @@ test-suite unit
   main-is:          Main.hs
   build-depends:
     , base
+    , containers
+    , delta-types
     , hspec >= 2.11.0 && < 2.12
+    , QuickCheck >= 2.14 && < 2.16
   build-tool-depends: hspec-discover:hspec-discover
   other-modules:
-    Data.DeltaSpec
+    Data.Delta.CoreSpec
+    Data.Delta.ListSpec
+    Data.Delta.SetSpec

lib/delta-types/src/Data/Delta/List.hs

@@ -29,3 +29,14 @@ newtype DeltaList a = Append [a]
 instance Delta (DeltaList a) where
     type Base (DeltaList a) = [a]
     apply (Append xs) ys = xs ++ ys
+
+-- | 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 (DeltaList a) where
+    (Append xs) <> (Append ys) = Append (xs ++ ys)
+
+instance Ord a => Monoid (DeltaList a) where
+    mempty = Append []

lib/delta-types/test/unit/Data/Delta/CoreSpec.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Data.Delta.CoreSpec
+    ( spec
+    ) where
+
+import Prelude
+
+import Data.Delta.Core
+    ( Replace (Replace)
+    , apply
+    )
+import Data.Delta.List
+    ( DeltaList (Append)
+    )
+import Test.Hspec
+    ( Spec
+    , describe
+    , it
+    )
+import Test.QuickCheck
+    ( property
+    , (===)
+    )
+
+{-----------------------------------------------------------------------------
+    Tests
+------------------------------------------------------------------------------}
+
+spec :: Spec
+spec = do
+    describe "Replace" $ do
+        it "apply is a morphism" $ property $
+            \(x :: Int) y z ->
+                apply (Replace x <> Replace y) z
+                    === (apply (Replace x) . apply (Replace y)) z
+
+        it "apply (Replace x <> _) = apply (Replace x)" $ property $
+            \(x :: Int) y z ->
+                apply (Replace x <> Replace y) z
+                    === apply (Replace x) z
+
+    describe "Lists of deltas" $ do
+        it "apply []" $ property $
+            \(z :: Int) ->
+                apply ([] :: [Replace Int]) z === z
+
+        it "apply is a morphism" $ property $
+            \xs ys (z :: [Int]) ->
+                let d1 = map Append xs
+                    d2 = map Append ys
+                in
+                    apply (d1 ++ d2) z
+                        === (apply d1 . apply d2) z

lib/delta-types/test/unit/Data/Delta/ListSpec.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Data.Delta.ListSpec
+    ( spec
+    ) where
+
+import Prelude
+
+import Data.Delta.Core
+    ( apply
+    )
+import Data.Delta.List
+    ( DeltaList (Append)
+    )
+import Test.Hspec
+    ( Spec
+    , describe
+    , it
+    )
+import Test.QuickCheck
+    ( Arbitrary (..)
+    , listOf
+    , property
+    , (===)
+    )
+
+{-----------------------------------------------------------------------------
+    Tests
+------------------------------------------------------------------------------}
+
+spec :: Spec
+spec = do
+    describe "DeltaList" $ do
+        it "apply definition" $ property $
+            \(xs :: [Int]) zs ->
+                apply (Append xs) zs
+                    === xs ++ zs
+
+        it "apply mempty" $ property $
+            \z ->
+                apply (mempty :: DeltaList Int) z
+                    === z
+
+        it "apply is a morphism" $ property $
+            \(x :: DeltaList Int) y zs ->
+                apply (x <> y) zs
+                    === (apply x . apply y) zs
+
+{-----------------------------------------------------------------------------
+    Random generators
+------------------------------------------------------------------------------}
+instance Arbitrary a => Arbitrary (DeltaList a) where
+    arbitrary = Append <$> listOf arbitrary

lib/delta-types/test/unit/Data/Delta/SetSpec.hs

@@ -0,0 +1,121 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Data.Delta.SetSpec
+    ( spec
+    ) where
+
+import Prelude
+
+import Data.Delta.Core
+    ( apply
+    )
+import Data.Delta.Set
+    ( DeltaSet1 (Delete, Insert)
+    , deltaSetFromList
+    , diffSet
+    , listFromDeltaSet
+    )
+import Data.List
+    ( foldl'
+    )
+import Data.Set
+    ( Set
+    )
+import Test.Hspec
+    ( Spec
+    , describe
+    , it
+    )
+import Test.QuickCheck
+    ( Arbitrary (..)
+    , Gen
+    , elements
+    , forAll
+    , infiniteList
+    , listOf
+    , oneof
+    , property
+    , (===)
+    , (==>)
+    , (.&&.)
+    )
+
+import qualified Data.Set as Set
+
+{-----------------------------------------------------------------------------
+    Tests
+------------------------------------------------------------------------------}
+
+spec :: Spec
+spec = do
+    describe "DeltaSet1" $ do
+        it "cancellation laws" $ property $
+            \(x :: Int) -> forAll (genSetWithOrWithout x) $ \zs ->
+                apply [Insert x, Delete x] zs === apply [Insert x] zs
+                .&&. apply [Insert x, Insert x] zs === apply [Insert x] zs
+                .&&. apply [Delete x, Insert x] zs === apply [Delete x] zs
+                .&&. apply [Delete x, Delete x] zs === apply [Delete x] zs
+
+    describe "DeltaSet" $ do
+        describe "diffSet" $ do
+            it "example" $ property $
+                \(a :: Int) b c ->
+                (a /= b && a /= c && b /= c) ==>
+                Set.fromList [a, c] `diffSet` Set.fromList [a, b]
+                    == deltaSetFromList [Insert c, Delete b]
+
+            it "new = apply (diffSet new old) old" $ property $
+                \(whole :: Set Int) -> forAll (genSubset whole) $
+                \old -> forAll (genSubset whole) $
+                \new ->
+                    new === apply (new `diffSet` old) old
+
+        describe "to/from DeltaSet1" $ do
+            it "deltaSetFromList . listFromDeltaSet = id" $ property $
+                \(whole :: Set Int) -> forAll (genSubset whole) $
+                \a -> forAll (genSubset whole) $
+                \b ->
+                    let d = (a `diffSet` b)
+                    in  d == (deltaSetFromList . listFromDeltaSet) d
+
+            it "apply (deltaSetFromList ds) = apply ds" $ property $
+                \(whole :: Set Int) ->
+                    forAll (genDeltaSet1FromElements whole) $
+                \xs -> forAll (genSubset whole) $
+                \zs ->
+                    apply (deltaSetFromList xs) zs
+                        === apply xs zs
+
+{-----------------------------------------------------------------------------
+    Random generators
+------------------------------------------------------------------------------}
+-- | Generate a 'Set' with equal chances of containing a given item.
+genSetWithOrWithout :: (Ord a, Arbitrary a) => a -> Gen (Set a)
+genSetWithOrWithout x =
+    oneof
+        [ Set.insert x <$> arbitrary
+        , Set.delete x <$> arbitrary
+        ]
+
+-- | Generate a random subset of a given 'Set'.
+-- Useful for generating multiple sets that have common elements.
+genSubset :: Ord a => Set a -> Gen (Set a)
+genSubset xs = do
+    isMembers <- infiniteList
+    pure
+        $ foldl' (flip addMember) Set.empty
+        $ zip (Set.toList xs) isMembers
+  where
+    addMember (x, True) = Set.insert x
+    addMember (_, False) = id
+
+-- | Generate a random list of 'DeltaSet1' by picking items from a 'Set'.
+genDeltaSet1FromElements :: Set a -> Gen [DeltaSet1 a]
+genDeltaSet1FromElements xs
+    | Set.null xs = pure []
+    | otherwise =
+        listOf $ oneof [Insert <$> genElement, Delete <$> genElement]
+  where
+    genElement = elements $ Set.toList xs