{-# LANGUAGE FlexibleInstances #-} module CRDT.Cv.LwwElementSet ( LwwElementSet (..) , add , initial , lookup , remove ) where import Prelude hiding (lookup) import Data.Foldable (for_) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import CRDT.LamportClock (Clock) import CRDT.LWW (LWW, advanceFromLWW) import qualified CRDT.LWW as LWW import Data.Semilattice (Semilattice) newtype LwwElementSet a = LES (Map a (LWW Bool)) deriving (LwwElementSet a -> LwwElementSet a -> Bool (LwwElementSet a -> LwwElementSet a -> Bool) -> (LwwElementSet a -> LwwElementSet a -> Bool) -> Eq (LwwElementSet a) forall a. Eq a => LwwElementSet a -> LwwElementSet a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: LwwElementSet a -> LwwElementSet a -> Bool $c/= :: forall a. Eq a => LwwElementSet a -> LwwElementSet a -> Bool == :: LwwElementSet a -> LwwElementSet a -> Bool $c== :: forall a. Eq a => LwwElementSet a -> LwwElementSet a -> Bool Eq, Int -> LwwElementSet a -> ShowS [LwwElementSet a] -> ShowS LwwElementSet a -> String (Int -> LwwElementSet a -> ShowS) -> (LwwElementSet a -> String) -> ([LwwElementSet a] -> ShowS) -> Show (LwwElementSet a) forall a. Show a => Int -> LwwElementSet a -> ShowS forall a. Show a => [LwwElementSet a] -> ShowS forall a. Show a => LwwElementSet a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [LwwElementSet a] -> ShowS $cshowList :: forall a. Show a => [LwwElementSet a] -> ShowS show :: LwwElementSet a -> String $cshow :: forall a. Show a => LwwElementSet a -> String showsPrec :: Int -> LwwElementSet a -> ShowS $cshowsPrec :: forall a. Show a => Int -> LwwElementSet a -> ShowS Show) instance Ord a => Semigroup (LwwElementSet a) where LES Map a (LWW Bool) m1 <> :: LwwElementSet a -> LwwElementSet a -> LwwElementSet a <> LES Map a (LWW Bool) m2 = Map a (LWW Bool) -> LwwElementSet a forall a. Map a (LWW Bool) -> LwwElementSet a LES ((LWW Bool -> LWW Bool -> LWW Bool) -> Map a (LWW Bool) -> Map a (LWW Bool) -> Map a (LWW Bool) forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a Map.unionWith LWW Bool -> LWW Bool -> LWW Bool forall a. Semigroup a => a -> a -> a (<>) Map a (LWW Bool) m1 Map a (LWW Bool) m2) instance Ord a => Semilattice (LwwElementSet a) initial :: LwwElementSet a initial :: LwwElementSet a initial = Map a (LWW Bool) -> LwwElementSet a forall a. Map a (LWW Bool) -> LwwElementSet a LES Map a (LWW Bool) forall k a. Map k a Map.empty add :: (Ord a, Clock m) => a -> LwwElementSet a -> m (LwwElementSet a) add :: a -> LwwElementSet a -> m (LwwElementSet a) add a value old :: LwwElementSet a old@(LES Map a (LWW Bool) m) = do LwwElementSet a -> m () forall (m :: * -> *) a. Clock m => LwwElementSet a -> m () advanceFromLES LwwElementSet a old LWW Bool tag <- Bool -> m (LWW Bool) forall (m :: * -> *) a. Clock m => a -> m (LWW a) LWW.initialize Bool True LwwElementSet a -> m (LwwElementSet a) forall (f :: * -> *) a. Applicative f => a -> f a pure (LwwElementSet a -> m (LwwElementSet a)) -> (Map a (LWW Bool) -> LwwElementSet a) -> Map a (LWW Bool) -> m (LwwElementSet a) forall b c a. (b -> c) -> (a -> b) -> a -> c . Map a (LWW Bool) -> LwwElementSet a forall a. Map a (LWW Bool) -> LwwElementSet a LES (Map a (LWW Bool) -> m (LwwElementSet a)) -> Map a (LWW Bool) -> m (LwwElementSet a) forall a b. (a -> b) -> a -> b $ a -> LWW Bool -> Map a (LWW Bool) -> Map a (LWW Bool) forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert a value LWW Bool tag Map a (LWW Bool) m remove :: (Ord a, Clock m) => a -> LwwElementSet a -> m (LwwElementSet a) remove :: a -> LwwElementSet a -> m (LwwElementSet a) remove a value old :: LwwElementSet a old@(LES Map a (LWW Bool) m) = do LwwElementSet a -> m () forall (m :: * -> *) a. Clock m => LwwElementSet a -> m () advanceFromLES LwwElementSet a old LWW Bool tag <- Bool -> m (LWW Bool) forall (m :: * -> *) a. Clock m => a -> m (LWW a) LWW.initialize Bool False LwwElementSet a -> m (LwwElementSet a) forall (f :: * -> *) a. Applicative f => a -> f a pure (LwwElementSet a -> m (LwwElementSet a)) -> (Map a (LWW Bool) -> LwwElementSet a) -> Map a (LWW Bool) -> m (LwwElementSet a) forall b c a. (b -> c) -> (a -> b) -> a -> c . Map a (LWW Bool) -> LwwElementSet a forall a. Map a (LWW Bool) -> LwwElementSet a LES (Map a (LWW Bool) -> m (LwwElementSet a)) -> Map a (LWW Bool) -> m (LwwElementSet a) forall a b. (a -> b) -> a -> b $ a -> LWW Bool -> Map a (LWW Bool) -> Map a (LWW Bool) forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert a value LWW Bool tag Map a (LWW Bool) m lookup :: Ord a => a -> LwwElementSet a -> Bool lookup :: a -> LwwElementSet a -> Bool lookup a value (LES Map a (LWW Bool) m) = Bool -> (LWW Bool -> Bool) -> Maybe (LWW Bool) -> Bool forall b a. b -> (a -> b) -> Maybe a -> b maybe Bool False LWW Bool -> Bool forall a. LWW a -> a LWW.query (Maybe (LWW Bool) -> Bool) -> Maybe (LWW Bool) -> Bool forall a b. (a -> b) -> a -> b $ a -> Map a (LWW Bool) -> Maybe (LWW Bool) forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup a value Map a (LWW Bool) m advanceFromLES :: Clock m => LwwElementSet a -> m () advanceFromLES :: LwwElementSet a -> m () advanceFromLES (LES Map a (LWW Bool) m) = Map a (LWW Bool) -> (LWW Bool -> m ()) -> m () forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ Map a (LWW Bool) m LWW Bool -> m () forall (m :: * -> *) a. Clock m => LWW a -> m () advanceFromLWW