crdt 10.3 → 10.4
raw patch · 2 files changed
+15/−25 lines, 2 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.Empty: instance Data.Empty.AsEmpty (GHC.Base.Maybe a)
- Data.Semilattice: instance Data.Semilattice.Semilattice a => Data.Semilattice.Semilattice (GHC.Base.Maybe a)
+ Data.Empty: instance Data.Empty.AsEmpty (GHC.Maybe.Maybe a)
+ Data.Semilattice: instance Data.Semilattice.Semilattice a => Data.Semilattice.Semilattice (GHC.Maybe.Maybe a)
- CRDT.Cm.ORSet: OpRemove :: a -> (Set Tag) -> ORSet a
+ CRDT.Cm.ORSet: OpRemove :: a -> Set Tag -> ORSet a
- CRDT.Cm.RGA: AddAfter :: (Maybe VertexId) -> a -> RgaIntent a
+ CRDT.Cm.RGA: AddAfter :: Maybe VertexId -> a -> RgaIntent a
- CRDT.Cm.RGA: OpAddAfter :: (Maybe VertexId) -> a -> VertexId -> RGA a
+ CRDT.Cm.RGA: OpAddAfter :: Maybe VertexId -> a -> VertexId -> RGA a
- CRDT.Cv.GCounter: GCounter :: (IntMap a) -> GCounter a
+ CRDT.Cv.GCounter: GCounter :: IntMap a -> GCounter a
- CRDT.Cv.LwwElementSet: LES :: (Map a (LWW Bool)) -> LwwElementSet a
+ CRDT.Cv.LwwElementSet: LES :: Map a (LWW Bool) -> LwwElementSet a
- CRDT.Cv.ORSet: ORSet :: (Map a (Map Tag Bool)) -> ORSet a
+ CRDT.Cv.ORSet: ORSet :: Map a (Map Tag Bool) -> ORSet a
- CRDT.Cv.PNCounter: PNCounter :: !(GCounter a) -> !(GCounter a) -> PNCounter a
+ CRDT.Cv.PNCounter: PNCounter :: !GCounter a -> !GCounter a -> PNCounter a
- CRDT.Cv.PNCounter: [negative] :: PNCounter a -> !(GCounter a)
+ CRDT.Cv.PNCounter: [negative] :: PNCounter a -> !GCounter a
- CRDT.Cv.PNCounter: [positive] :: PNCounter a -> !(GCounter a)
+ CRDT.Cv.PNCounter: [positive] :: PNCounter a -> !GCounter a
- CRDT.Cv.TwoPSet: TwoPSet :: (Map a Bool) -> TwoPSet a
+ CRDT.Cv.TwoPSet: TwoPSet :: Map a Bool -> TwoPSet a
- CRDT.LamportClock: runLamportClock :: TVar LocalTime -> LamportClock a -> IO a
+ CRDT.LamportClock: runLamportClock :: IORef LocalTime -> LamportClock a -> IO a
- CRDT.LamportClock.Simulation: LamportClockSim :: (ExceptT String (StateT (Map Pid LocalTime) m) a) -> LamportClockSimT m a
+ CRDT.LamportClock.Simulation: LamportClockSim :: ExceptT String (StateT (Map Pid LocalTime) m) a -> LamportClockSimT m a
- CRDT.LamportClock.Simulation: ProcessSim :: (ReaderT Pid (LamportClockSimT m) a) -> ProcessSimT m a
+ CRDT.LamportClock.Simulation: ProcessSim :: ReaderT Pid (LamportClockSimT m) a -> ProcessSimT m a
- Data.MultiMap: MultiMap :: (Map k (Set v)) -> MultiMap k v
+ Data.MultiMap: MultiMap :: Map k (Set v) -> MultiMap k v
Files
- crdt.cabal +4/−4
- lib/CRDT/LamportClock.hs +11/−21
crdt.cabal view
@@ -1,10 +1,10 @@ name: crdt-version: 10.3+version: 10.4 -- ^ ComVer category: Distributed Systems copyright:- 2017 Yuriy Syrovetskiy, Nikolay Loginov;- 2018 Yuriy Syrovetskiy+ 2017 Yuriy Syrovetskiy, Nikolay Loginov;+ 2018-2019 Yuriy Syrovetskiy maintainer: Yuriy Syrovetskiy <cblp@cblp.su> license: BSD3 license-file: LICENSE@@ -22,7 +22,7 @@ library hs-source-dirs: lib- build-depends: base >= 4.8 && < 4.12+ build-depends: base >= 4.8 && < 4.13 , binary , bytestring , containers >= 0.5.9
lib/CRDT/LamportClock.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NamedFieldPuns #-} module CRDT.LamportClock ( Pid (..)@@ -19,12 +16,11 @@ , getMacAddress ) where -import Control.Concurrent.STM (TVar, atomically, modifyTVar',- readTVar, writeTVar) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Reader (ReaderT, ask, runReaderT)+import Control.Monad.Reader (ReaderT (..)) import Control.Monad.State.Strict (StateT) import Control.Monad.Trans (lift)+import Data.IORef (IORef, atomicModifyIORef') import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word64) import Numeric.Natural (Natural)@@ -69,33 +65,27 @@ getTime :: Clock m => m LamportTime getTime = getTimes 1 --- TODO(cblp, 2018-01-06) benchmark and compare with 'atomicModifyIORef'-newtype LamportClock a = LamportClock (ReaderT (TVar LocalTime) IO a)+newtype LamportClock a = LamportClock (ReaderT (IORef LocalTime) IO a) deriving (Applicative, Functor, Monad, MonadIO) -runLamportClock :: TVar LocalTime -> LamportClock a -> IO a+runLamportClock :: IORef LocalTime -> LamportClock a -> IO a runLamportClock var (LamportClock action) = runReaderT action var instance Process LamportClock where getPid = Pid <$> liftIO getMacAddress instance Clock LamportClock where- advance time = LamportClock $ do- timeVar <- ask- lift $ atomically $ modifyTVar' timeVar $ max time+ advance time = LamportClock $ ReaderT $ \timeVar ->+ atomicModifyIORef' timeVar $ \t0 -> (max time t0, ()) getTimes n' = LamportTime <$> getTimes' <*> getPid where n = max n' 1- getTimes' = LamportClock $ do- timeVar <- ask- lift $ do- realTime <- getRealLocalTime- atomically $ do- timeCur <- readTVar timeVar- let timeRangeStart = max realTime (timeCur + 1)- writeTVar timeVar $ timeRangeStart + n - 1- pure timeRangeStart+ getTimes' = LamportClock $ ReaderT $ \timeVar -> do+ realTime <- getRealLocalTime+ atomicModifyIORef' timeVar $ \timeCur ->+ let timeRangeStart = max realTime (timeCur + 1)+ in (timeRangeStart + n - 1, timeRangeStart) instance Process m => Process (ReaderT r m) where getPid = lift getPid