module CRDT.LWW
( LWW (..)
, initial
, assign
, query
, advanceFromLWW
) where
import Data.Semigroup (Semigroup, (<>))
import Data.Semilattice (Semilattice)
import CRDT.Cm (CausalOrd (..), CmRDT (..))
import CRDT.LamportClock (LamportTime, Process, advance, getTime)
data LWW a = LWW
{ value :: !a
, time :: !LamportTime
}
deriving (Eq, Show)
instance Eq a => Semigroup (LWW a) where
x@(LWW xv xt) <> y@(LWW yv yt)
| xt < yt = y
| yt < xt = x
| xv == yv = x
| otherwise = error "LWW assumes timestamps to be unique"
instance Eq a => Semilattice (LWW a)
initial :: a -> Process (LWW a)
initial value = LWW value <$> getTime
assign :: a -> LWW a -> Process (LWW a)
assign value old = do
advanceFromLWW old
initial value
query :: LWW a -> a
query = value
instance CausalOrd (LWW a) where
precedes _ _ = False
instance Eq a => CmRDT (LWW a) where
type Intent (LWW a) = a
type Payload (LWW a) = LWW a
makeOp value = Just . assign value
apply = (<>)
advanceFromLWW :: LWW a -> Process ()
advanceFromLWW LWW{time} = advance time