{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module CRDT.Cm
( CausalOrd (..)
, CmRDT (..)
, concurrent
, query
, makeAndApplyOp
, makeAndApplyOps
) where
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail, fail)
import Control.Monad.State.Strict (MonadState, get, modify)
import CRDT.LamportClock (Clock)
class CausalOrd a where
precedes :: a -> a -> Bool
comparable :: CausalOrd a => a -> a -> Bool
comparable a b = a `precedes` b || b `precedes` a
concurrent :: CausalOrd a => a -> a -> Bool
concurrent a b = not $ comparable a b
class (CausalOrd op, Eq (Payload op)) => CmRDT op where
type Intent op
type Intent op = op
type Payload op
initial :: Payload op
makeOp :: Clock m => Intent op -> Payload op -> Maybe (m op)
default makeOp
:: (Intent op ~ op, Applicative m)
=> Intent op -> Payload op -> Maybe (m op)
makeOp i _ = Just $ pure i
apply :: op -> Payload op -> Payload op
query :: forall op f . (CmRDT op, Foldable f) => f op -> Payload op
query = foldl (flip apply) (initial @op)
makeAndApplyOp
:: (CmRDT op, Clock m, MonadFail m, MonadState (Payload op) m)
=> Intent op
-> m op
makeAndApplyOp intent = do
payload <- get
case makeOp intent payload of
Nothing -> fail "precodition failed"
Just opAction -> do
op <- opAction
modify $ apply op
pure op
makeAndApplyOps
:: ( CmRDT op
, Clock m
, MonadFail m
, MonadState (Payload op) m
, Traversable f
)
=> f (Intent op)
-> m (f op)
makeAndApplyOps = traverse makeAndApplyOp