diff --git a/crdt.cabal b/crdt.cabal --- a/crdt.cabal +++ b/crdt.cabal @@ -1,16 +1,19 @@ name: crdt -version: 10.5 +version: 10.6 -- ^ ComVer category: Distributed Systems copyright: 2017 Yuriy Syrovetskiy, Nikolay Loginov; - 2018-2019 Yuriy Syrovetskiy + 2018-2020 Yuriy Syrovetskiy maintainer: Yuriy Syrovetskiy license: BSD3 license-file: LICENSE synopsis: Conflict-free replicated data types description: Definitions of CmRDT and CvRDT. Implementations for some classic CRDTs. + . + This package is just for experiments, so it supports only one GHC version. + For real CRDT applications, use `ron` package. homepage: https://github.com/cblp/crdt#readme bug-reports: https://github.com/cblp/crdt/issues cabal-version: >= 1.10 @@ -22,12 +25,12 @@ library hs-source-dirs: lib - build-depends: base >= 4.8 && < 4.13 + build-depends: base >= 4.8 && < 4.14 , binary , bytestring , containers >= 0.5.9 -- since lookupMax is used - , Diff < 0.4 + , Diff >= 0.4 , hashable , mtl , network-info diff --git a/lib/CRDT/Cm.hs b/lib/CRDT/Cm.hs --- a/lib/CRDT/Cm.hs +++ b/lib/CRDT/Cm.hs @@ -14,9 +14,6 @@ , makeAndApplyOps ) where -import Prelude hiding (fail) - -import Control.Monad.Fail (MonadFail, fail) import Control.Monad.State.Strict (MonadState, get, modify) import CRDT.LamportClock (Clock) diff --git a/lib/CRDT/Cm/RGA.hs b/lib/CRDT/Cm/RGA.hs --- a/lib/CRDT/Cm/RGA.hs +++ b/lib/CRDT/Cm/RGA.hs @@ -17,12 +17,10 @@ import Prelude hiding (lookup) -import Control.Monad.Fail (MonadFail) import Control.Monad.State.Strict (MonadState) import Data.Empty (AsEmpty (..)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Semigroup ((<>)) import Data.Vector (Vector, (//)) import qualified Data.Vector as Vector diff --git a/lib/CRDT/Cv/GCounter.hs b/lib/CRDT/Cv/GCounter.hs --- a/lib/CRDT/Cv/GCounter.hs +++ b/lib/CRDT/Cv/GCounter.hs @@ -8,7 +8,6 @@ import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IntMap -import Data.Semigroup (Semigroup ((<>))) import Data.Semilattice (Semilattice) -- | Grow-only counter. diff --git a/lib/CRDT/Cv/LwwElementSet.hs b/lib/CRDT/Cv/LwwElementSet.hs --- a/lib/CRDT/Cv/LwwElementSet.hs +++ b/lib/CRDT/Cv/LwwElementSet.hs @@ -13,7 +13,6 @@ import Data.Foldable (for_) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Semigroup (Semigroup (..)) import CRDT.LamportClock (Clock) import CRDT.LWW (LWW, advanceFromLWW) @@ -35,13 +34,13 @@ add value old@(LES m) = do advanceFromLES old tag <- LWW.initialize True - pure . LES $ Map.insertWith (<>) value tag m + pure . LES $ Map.insert value tag m remove :: (Ord a, Clock m) => a -> LwwElementSet a -> m (LwwElementSet a) remove value old@(LES m) = do advanceFromLES old tag <- LWW.initialize False - pure . LES $ Map.insertWith (<>) value tag m + pure . LES $ Map.insert value tag m lookup :: Ord a => a -> LwwElementSet a -> Bool lookup value (LES m) = maybe False LWW.query $ Map.lookup value m diff --git a/lib/CRDT/Cv/ORSet.hs b/lib/CRDT/Cv/ORSet.hs --- a/lib/CRDT/Cv/ORSet.hs +++ b/lib/CRDT/Cv/ORSet.hs @@ -11,7 +11,6 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) -import Data.Semigroup (Semigroup, (<>)) import Numeric.Natural (Natural) import CRDT.LamportClock (Pid, Process, getPid) diff --git a/lib/CRDT/Cv/PNCounter.hs b/lib/CRDT/Cv/PNCounter.hs --- a/lib/CRDT/Cv/PNCounter.hs +++ b/lib/CRDT/Cv/PNCounter.hs @@ -9,7 +9,6 @@ , increment ) where -import Data.Semigroup (Semigroup (..)) import Data.Semilattice (Semilattice) import CRDT.Cv.GCounter (GCounter) diff --git a/lib/CRDT/Cv/RGA.hs b/lib/CRDT/Cv/RGA.hs --- a/lib/CRDT/Cv/RGA.hs +++ b/lib/CRDT/Cv/RGA.hs @@ -15,11 +15,10 @@ , unpack ) where -import Data.Algorithm.Diff (Diff (Both, First, Second), +import Data.Algorithm.Diff (PolyDiff (Both, First, Second), getGroupedDiffBy) import Data.Empty (AsEmpty (..)) import Data.Function (on) -import Data.Semigroup (Semigroup, (<>)) import Data.Semilattice (Semilattice) import Data.Traversable (for) diff --git a/lib/CRDT/Cv/TwoPSet.hs b/lib/CRDT/Cv/TwoPSet.hs --- a/lib/CRDT/Cv/TwoPSet.hs +++ b/lib/CRDT/Cv/TwoPSet.hs @@ -10,8 +10,6 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe) -import Data.Semigroup (Semigroup ((<>))) import Data.Semilattice (Semilattice) @@ -30,7 +28,7 @@ initial = TwoPSet Map.empty member :: Ord a => a -> TwoPSet a -> Bool -member e (TwoPSet m) = fromMaybe False $ Map.lookup e m +member e (TwoPSet m) = Just True == Map.lookup e m remove :: Ord a => a -> TwoPSet a -> TwoPSet a remove e (TwoPSet m) = TwoPSet $ Map.adjust (const False) e m diff --git a/lib/CRDT/LWW.hs b/lib/CRDT/LWW.hs --- a/lib/CRDT/LWW.hs +++ b/lib/CRDT/LWW.hs @@ -15,8 +15,6 @@ , advanceFromLWW ) where -import Data.Semigroup (Semigroup, (<>)) - import Data.Semilattice (Semilattice) #if __GLASGOW_HASKELL__ >= 800 diff --git a/lib/CRDT/LamportClock.hs b/lib/CRDT/LamportClock.hs --- a/lib/CRDT/LamportClock.hs +++ b/lib/CRDT/LamportClock.hs @@ -60,6 +60,7 @@ -> m LamportTime -- ^ Starting value of the range. -- So return value @t@ means range @[t .. t + n - 1]@. + advance :: LocalTime -> m () getTime :: Clock m => m LamportTime diff --git a/lib/CRDT/LamportClock/Simulation.hs b/lib/CRDT/LamportClock/Simulation.hs --- a/lib/CRDT/LamportClock/Simulation.hs +++ b/lib/CRDT/LamportClock/Simulation.hs @@ -9,8 +9,10 @@ -- * Lamport clock simulation LamportClockSim , LamportClockSimT (..) + , ObservedTime (..) , ProcessSim , ProcessSimT (..) + , evalProcessSim , runLamportClockSim , runLamportClockSimT , runProcessSim @@ -19,18 +21,21 @@ import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError) -import Control.Monad.Fail (MonadFail) -import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Reader (ReaderT, ask, runReaderT) +import Control.Monad.Reader (ask) +import Control.Monad.RWS.Strict (RWST, evalRWST, tell) import Control.Monad.State.Strict (StateT, evalState, evalStateT, modify, state) import Control.Monad.Trans (MonadTrans, lift) +import Data.Bifunctor (second) +import Data.Foldable (toList) import Data.Functor.Identity (Identity) import Data.Hashable (hash) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq import Numeric.Natural (Natural) import CRDT.LamportClock (Clock, LamportTime (LamportTime), LocalTime, @@ -58,8 +63,11 @@ type LamportClockSim = LamportClockSimT Identity +data ObservedTime = ObservedTime{stamp :: LocalTime, count :: Natural} + -- | ProcessSim inside Lamport clock simulation. -newtype ProcessSimT m a = ProcessSim (ReaderT Pid (LamportClockSimT m) a) +newtype ProcessSimT m a = + ProcessSim (RWST Pid (Seq ObservedTime) () (LamportClockSimT m) a) deriving (Applicative, Functor, Monad, MonadFail) type ProcessSim = ProcessSimT Identity @@ -74,6 +82,7 @@ getTimes n' = ProcessSim $ do pid <- ask time <- lift $ preIncreaseTime n pid + tell $ Seq.singleton ObservedTime{stamp = time, count = n} pure $ LamportTime time pid where n = max n' 1 @@ -98,10 +107,14 @@ evalStateT (runExceptT action) mempty runProcessSim :: Pid -> ProcessSim a -> LamportClockSim a -runProcessSim pid (ProcessSim action) = runReaderT action pid +runProcessSim = runProcessSimT -runProcessSimT :: Pid -> ProcessSimT m a -> LamportClockSimT m a -runProcessSimT pid (ProcessSim action) = runReaderT action pid +runProcessSimT :: Monad m => Pid -> ProcessSimT m a -> LamportClockSimT m a +runProcessSimT pid (ProcessSim action) = fst <$> evalRWST action pid () + +evalProcessSim :: Pid -> ProcessSim a -> LamportClockSim (a, [ObservedTime]) +evalProcessSim pid (ProcessSim action) = + second toList <$> evalRWST action pid () -- | Increase time by pid and return new value preIncreaseTime :: Monad m => Natural -> Pid -> LamportClockSimT m LocalTime diff --git a/lib/Data/MultiMap.hs b/lib/Data/MultiMap.hs --- a/lib/Data/MultiMap.hs +++ b/lib/Data/MultiMap.hs @@ -15,7 +15,6 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) -import Data.Semigroup ((<>)) import Data.Set (Set) import qualified Data.Set as Set diff --git a/lib/Data/Semilattice.hs b/lib/Data/Semilattice.hs --- a/lib/Data/Semilattice.hs +++ b/lib/Data/Semilattice.hs @@ -3,7 +3,7 @@ , merge ) where -import Data.Semigroup (Max, Semigroup, (<>)) +import Data.Semigroup (Max) import Data.Set (Set) {- | @@ -13,7 +13,7 @@ If it matters for you, use package @lattices@. -In addition to 'Semigroup', Semilattice defines this laws: +In addition to 'Semigroup', Semilattice defines these laws: [commutativity]