crdt 0.3 → 0.4

raw patch · 17 files changed

+309/−138 lines, 17 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• crdt.cabal +10/−4
• lib/CRDT/Cm.hs +1/−6
• lib/CRDT/GCounter/Cm.hs +2/−1
• lib/CRDT/GSet/Cv.hs +20/−0
• lib/CRDT/GSet/Cv/Internal.hs +12/−0
• lib/CRDT/LWW.hs +18/−5
• lib/CRDT/Timestamp.hs +7/−0
• lib/Data/Semilattice.hs +6/−7
• test/GCounter.hs +42/−0
• test/GSet.hs +26/−0
• test/Instances.hs +0/−4
• test/Instances/Cm.hs +0/−14
• test/Instances/Cv.hs +0/−16
• test/LWW.hs +57/−0
• test/Laws.hs +56/−0
• test/Main.hs +6/−81
• test/PNCounter.hs +46/−0

@@ -3,13 +3,14 @@ -- see: https://github.com/sol/hpack  name:           crdt-version:        0.3+version:        0.4 synopsis:       Conflict-free replicated data types description:    Definitions of CmRDT and CvRDT. Implementations for some classic CRDTs. category:       Distributed Systems homepage:       https://github.com/cblp/crdt#readme bug-reports:    https://github.com/cblp/crdt/issues maintainer:     Yuriy Syrovetskiy <cblp@cblp.su>+copyright:      © 2017  Yuriy Syrovetskiy <cblp@cblp.su>, Nikolay Loginov <kemphack@mail.ru> license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -31,10 +32,13 @@       CRDT.GCounter.Cm       CRDT.GCounter.Cv       CRDT.GCounter.Cv.Internal+      CRDT.GSet.Cv+      CRDT.GSet.Cv.Internal       CRDT.LWW       CRDT.PNCounter.Cm       CRDT.PNCounter.Cv       CRDT.PNCounter.Cv.Internal+      CRDT.Timestamp       Data.Semilattice   default-language: Haskell2010 @@ -51,7 +55,9 @@     , tasty-quickcheck     , crdt   other-modules:-      Instances-      Instances.Cm-      Instances.Cv+      GCounter+      GSet+      Laws+      LWW+      PNCounter   default-language: Haskell2010

@@ -2,10 +2,9 @@  module CRDT.Cm     ( CmRDT (..)-    , query     ) where -import Data.Kind (Type)+import           Data.Kind (Type)  {- | Operation-based, or commutative (Cm) replicated data type.@@ -23,7 +22,3 @@      -- | Apply operation to a value     update :: op -> State op -> State op---- | Build state from a series of operations.-query :: (Foldable f, CmRDT op) => f op -> State op -> State op-query ops initial = foldr update initial ops

@@ -5,12 +5,13 @@     , initial     ) where -import CRDT.Cm (CmRDT, State, update)+import           CRDT.Cm (CmRDT, State, update)  -- | Grow-only counter. -- -- Commutativity: 'Increment' obviously commutes with itself. data GCounter a = Increment+    deriving (Show)  instance Num a => CmRDT (GCounter a) where     type State (GCounter a) = a

@@ -0,0 +1,20 @@+module CRDT.GSet.Cv+    ( add+    , initial+    , query+    ) where++import qualified Data.Set as Set++import CRDT.GSet.Cv.Internal++-- | update+add :: Ord a => a -> GSet a -> GSet a+add = Set.insert++-- | initialization+initial :: GSet a+initial = Set.empty++query :: Ord a => a -> GSet a -> Bool+query = Set.member

@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module CRDT.GSet.Cv.Internal where++import Data.Set (Set)++import CRDT.Cv  (CvRDT)++-- | Grow-only set+type GSet = Set++instance Ord a => CvRDT (Set a)

@@ -2,17 +2,17 @@  module CRDT.LWW     ( LWW (..)-    , Timestamp+    , point+    , write+    , query     ) where -import Data.Semigroup  (Semigroup (..))-import Numeric.Natural (Natural)+import           Data.Semigroup (Semigroup (..))  import           CRDT.Cm (CmRDT, State) import qualified CRDT.Cm as Cm import           CRDT.Cv (CvRDT)--type Timestamp = Natural+import           CRDT.Timestamp (Timestamp)  -- | Last write wins. Interesting, this type is both 'CmRDT' and 'CvRDT'. data LWW a = Write@@ -21,6 +21,7 @@     }     deriving (Eq, Ord, Show) +-- | Merge by choosing more recent timestamp. instance Ord a => Semigroup (LWW a) where     (<>) = max @@ -29,3 +30,15 @@     update = max  instance Ord a => CvRDT (LWW a)++-- | Initialize state+point :: Timestamp -> a -> LWW a+point = Write++-- | Change state+write :: Ord a => Timestamp -> a -> LWW a -> LWW a+write t v s = Write t v <> s++-- | Query state+query :: LWW a -> a+query = value

@@ -0,0 +1,7 @@+module CRDT.Timestamp+    ( Timestamp+    ) where++import           Numeric.Natural (Natural)++type Timestamp = Natural

@@ -1,10 +1,9 @@ module Data.Semilattice     ( Semilattice-    , (<>)+    , slappend     ) where -import           Data.Semigroup (Semigroup)-import qualified Data.Semigroup as Semigroup+import           Data.Semigroup (Semigroup, (<>))  {- | A semilattice.@@ -26,7 +25,7 @@ class Semigroup a => Semilattice a  -- | Just ('Semigroup.<>'), specialized to 'Semilattice'.-(<>) :: Semilattice a => a -> a -> a-(<>) = (Semigroup.<>)-infixr 6 <>-{-# INLINE (<>) #-}+slappend :: Semilattice a => a -> a -> a+slappend = (<>)+infixr 6 `slappend`+{-# INLINE slappend #-}

@@ -0,0 +1,42 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}++module GCounter+    ( gCounter+    ) where++import           Test.QuickCheck (Arbitrary, arbitrary)+import           Test.Tasty (TestTree, testGroup)+import           Test.Tasty.QuickCheck (testProperty)++import           CRDT.Cm (update)+import qualified CRDT.GCounter.Cm as Cm+import qualified CRDT.GCounter.Cv as Cv+import qualified CRDT.GCounter.Cv.Internal as Cv++import           Laws (cmrdtLaws, cvrdtLaws)++instance Arbitrary (Cm.GCounter a) where+    arbitrary = pure Cm.Increment++deriving instance Arbitrary a => Arbitrary (Cv.GCounter a)++gCounter :: TestTree+gCounter = testGroup "GCounter"+    [ testGroup "Cv"+        [ cvrdtLaws @(Cv.GCounter Int)+        , testProperty "increment" $+            \(counter :: Cv.GCounter Int) i ->+                Cv.query (Cv.increment i counter)+                == succ (Cv.query counter)+        ]+    , testGroup "Cm"+        [ cmrdtLaws @(Cm.GCounter Int)+        , testProperty "increment" $+            \(counter :: Int) -> update Cm.Increment counter == succ counter+        ]+    ]

@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module GSet+    ( gSet+    ) where++import           Test.Tasty (TestTree, testGroup)+import           Test.Tasty.QuickCheck (testProperty, (==>))++import qualified CRDT.GSet.Cv as Cv+import qualified CRDT.GSet.Cv.Internal as Cv++import           Laws (cvrdtLaws)++gSet :: TestTree+gSet = testGroup "GSet"+    [ testGroup "Cv"+        [ cvrdtLaws @(Cv.GSet Int)+        , testProperty "add" $+            \(set :: Cv.GSet Int) i ->+                not (Cv.query i set) ==> Cv.query i (Cv.add i set)+        ]+    ]

@@ -1,4 +0,0 @@-module Instances () where--import Instances.Cm ()-import Instances.Cv ()

@@ -1,14 +0,0 @@-{-# OPTIONS_GHC -Wno-orphans #-}--module Instances.Cm () where--import Test.QuickCheck (Arbitrary, arbitrary, arbitraryBoundedEnum)--import CRDT.LWW          (LWW (..))-import CRDT.PNCounter.Cm (PNCounter (..))--instance Arbitrary (PNCounter a) where-    arbitrary = arbitraryBoundedEnum--instance Arbitrary a => Arbitrary (LWW a) where-    arbitrary = Write <$> arbitrary <*> arbitrary

@@ -1,16 +0,0 @@-{-# OPTIONS_GHC -Wno-orphans #-}--{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}--module Instances.Cv () where--import           Test.QuickCheck (Arbitrary, arbitrary)--import           CRDT.GCounter.Cv.Internal (GCounter (..))-import           CRDT.PNCounter.Cv.Internal (PNCounter (..))--deriving instance Arbitrary a => Arbitrary (GCounter a)--instance Arbitrary a => Arbitrary (PNCounter a) where-    arbitrary = PNCounter <$> arbitrary <*> arbitrary

@@ -0,0 +1,57 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module LWW (lww) where++import           Test.QuickCheck (Arbitrary, arbitrary)+import           Test.Tasty (TestTree, testGroup)+import           Test.Tasty.QuickCheck (Positive (..), testProperty)++import           CRDT.Cm (update)+import           CRDT.LWW (LWW (Write), point, query, write)++import           Laws (cmrdtLaws, cvrdtLaws)++instance Arbitrary a => Arbitrary (LWW a) where+    arbitrary = Write <$> arbitrary <*> arbitrary++lww :: TestTree+lww = testGroup "LWW"+    [ testGroup "Cm"+        [ cmrdtLaws @(LWW Int)+        , testProperty "write latter" $+            \formerTime (formerValue :: Int) (Positive dt) latterValue -> let+                latterTime = formerTime + dt+                state = point formerTime formerValue+                state' = update (Write latterTime latterValue) state+                in+                query state' == latterValue+        , testProperty "write former" $+            \formerTime (formerValue :: Int) (Positive dt) latterValue -> let+                latterTime = formerTime + dt+                state = point latterTime latterValue+                state' = update (Write formerTime formerValue) state+                in+                query state' == latterValue+        ]+    , testGroup "Cv"+        [ cvrdtLaws @(LWW Int)+        , testProperty "write latter" $+            \formerTime (formerValue :: Int) (Positive dt) latterValue -> let+                latterTime = formerTime + dt+                state = point formerTime formerValue+                state' = write latterTime latterValue state+                in+                query state' == latterValue+        , testProperty "write former" $+            \formerTime (formerValue :: Int) (Positive dt) latterValue -> let+                latterTime = formerTime + dt+                state = point latterTime latterValue+                state' = write formerTime formerValue state+                in+                query state' == latterValue+        ]+    ]

@@ -0,0 +1,56 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Laws+    ( cmrdtLaws+    , cvrdtLaws+    , semigroupLaw+    , semilatticeLaws+    ) where++import           Data.Semigroup (Semigroup, (<>))+import           Data.Semilattice (Semilattice, slappend)+import           Test.QuickCheck (Arbitrary)+import           Test.Tasty (TestTree, testGroup)+import           Test.Tasty.QuickCheck (testProperty)++import           CRDT.Cm (CmRDT, State, update)+import           CRDT.Cv (CvRDT)++semigroupLaw :: forall a . (Arbitrary a, Semigroup a, Eq a, Show a) => TestTree+semigroupLaw =+    testGroup "Semigroup law" [testProperty "associativity" associativity]+  where+    associativity :: a -> a -> a -> Bool+    associativity x y z = (x <> y) <> z == x <> (y <> z)++semilatticeLaws+    :: forall a . (Arbitrary a, Semilattice a, Eq a, Show a) => TestTree+semilatticeLaws = testGroup "Semilattice laws"+    [ semigroupLaw @a+    , testProperty "commutativity" commutativity+    , testProperty "idempotency"   idempotency+    ]+  where+    commutativity :: a -> a -> Bool+    commutativity x y = x `slappend` y == y `slappend` x++    idempotency :: a -> Bool+    idempotency x = x `slappend` x == x++cvrdtLaws :: forall a . (Arbitrary a, CvRDT a, Eq a, Show a) => TestTree+cvrdtLaws = semilatticeLaws @a++cmrdtLaws+    :: forall op+    . ( Arbitrary op, CmRDT op, Show op+      , Arbitrary (State op), Eq (State op), Show (State op)+      )+    => TestTree+cmrdtLaws = testProperty "CmRDT law: commutativity" commutativity+  where+    commutativity :: op -> op -> State op -> Bool+    commutativity op1 op2 x =+        (update op1 . update op2) x == (update op2 . update op1) x

@@ -1,84 +1,9 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--import           Data.Proxy (Proxy (..))-import           Data.Semilattice (Semilattice, (<>))-import           Test.QuickCheck (Arbitrary, Small (..))-import           Test.Tasty (TestTree, defaultMain, testGroup)-import           Test.Tasty.QuickCheck (testProperty)--import           CRDT.Cm (CmRDT, State)-import qualified CRDT.Cm as Cm-import           CRDT.Cv (CvRDT)-import qualified CRDT.GCounter.Cv as GcCv-import           CRDT.LWW (LWW)-import qualified CRDT.PNCounter.Cm as PncCm-import qualified CRDT.PNCounter.Cv as PncCv+import           Test.Tasty (defaultMain, testGroup) -import           Instances ()+import           GCounter (gCounter)+import           LWW (lww)+import           PNCounter (pnCounter)+import           GSet      (gSet)  main :: IO ()-main = defaultMain $ testGroup "" [gCounter, pnCounter, lww]--gCounter :: TestTree-gCounter = testGroup "GCounter"-    [ testGroup "Cv"-        [ cvrdtLaws (Proxy :: Proxy (GcCv.GCounter Int))-        , testProperty "increment" $-            \(c :: GcCv.GCounter Int) (Small i) ->-                GcCv.query (GcCv.increment i c) == succ (GcCv.query c)-        ]-    ]--pnCounter :: TestTree-pnCounter = testGroup "PNCounter"-    [ testGroup "Cv"-        [ cvrdtLaws (Proxy :: Proxy (PncCv.PNCounter Int))-        , testProperty "increment" $-            \(c :: PncCv.PNCounter Int) (Small i) ->-                PncCv.query (PncCv.increment i c) == succ (PncCv.query c)-        , testProperty "decrement" $-            \(c :: PncCv.PNCounter Int) (Small i) ->-                PncCv.query (PncCv.decrement i c) == pred (PncCv.query c)-        ]-    , testGroup "Cm"-        [ cmrdtLaws (Proxy :: Proxy (PncCm.PNCounter Int)) ]-    ]--lww :: TestTree-lww = testGroup "LWW"-    [ testGroup "Cm" [ cmrdtLaws (Proxy :: Proxy (LWW Int)) ]-    , testGroup "Cv" [ cvrdtLaws (Proxy :: Proxy (LWW Int)) ]-    ]--semilatticeLaws-    :: forall a . (Arbitrary a, CvRDT a, Eq a, Show a) => Proxy a -> TestTree-semilatticeLaws _ = testGroup "Semilattice laws"-    [ testProperty "associativity" associativity-    , testProperty "commutativity" commutativity-    , testProperty "idempotency"   idempotency-    ]-  where-    associativity :: a -> a -> a -> Bool-    associativity x y z = (x <> y) <> z == x <> (y <> z)--    commutativity :: a -> a -> Bool-    commutativity x y = x <> y == y <> x--    idempotency :: a -> Bool-    idempotency x = x <> x == x--cvrdtLaws :: (Arbitrary a, Semilattice a, Eq a, Show a) => Proxy a -> TestTree-cvrdtLaws = semilatticeLaws--cmrdtLaws-    :: forall op-    . ( Arbitrary op, CmRDT op, Show op-      , Arbitrary (State op), Eq (State op), Show (State op)-      )-    => Proxy op -> TestTree-cmrdtLaws _ = testProperty "CmRDT law: commutativity" commutativity-  where-    commutativity :: op -> op -> State op -> Bool-    commutativity op1 op2 x =-        (Cm.update op1 . Cm.update op2) x == (Cm.update op2 . Cm.update op1) x+main = defaultMain $ testGroup "" [gCounter, gSet, lww, pnCounter]

@@ -0,0 +1,46 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module PNCounter+    ( pnCounter+    ) where++import           Test.QuickCheck (Arbitrary, arbitrary, arbitraryBoundedEnum)+import           Test.Tasty (TestTree, testGroup)+import           Test.Tasty.QuickCheck (testProperty)++import           CRDT.Cm (update)+import qualified CRDT.PNCounter.Cm as Cm+import qualified CRDT.PNCounter.Cv as Cv+import qualified CRDT.PNCounter.Cv.Internal as Cv++import           GCounter ()+import           Laws (cmrdtLaws, cvrdtLaws)++instance Arbitrary (Cm.PNCounter a) where+    arbitrary = arbitraryBoundedEnum++instance Arbitrary a => Arbitrary (Cv.PNCounter a) where+    arbitrary = Cv.PNCounter <$> arbitrary <*> arbitrary++pnCounter :: TestTree+pnCounter = testGroup "PNCounter"+    [ testGroup "Cv"+        [ cvrdtLaws @(Cv.PNCounter Int)+        , testProperty "increment" $+            \(counter :: Cv.PNCounter Int) i ->+                Cv.query (Cv.increment i counter) == succ (Cv.query counter)+        , testProperty "decrement" $+            \(counter :: Cv.PNCounter Int) i ->+                Cv.query (Cv.decrement i counter) == pred (Cv.query counter)+        ]+    , testGroup "Cm"+        [ cmrdtLaws @(Cm.PNCounter Int)+        , testProperty "increment" $+            \(counter :: Int) -> update Cm.Increment counter == succ counter+        , testProperty "decrement" $+            \(counter :: Int) -> update Cm.Decrement counter == pred counter+        ]+    ]