{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}

-- | TODO(cblp, 2017-09-29) USet?
module CRDT.Cm.TwoPSet
    ( TwoPSet (..)
    ) where

import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

import           CRDT.Cm (CausalOrd (..), CmRDT (..))

data TwoPSet a = Add a | Remove a
    deriving (TwoPSet a -> TwoPSet a -> Bool
(TwoPSet a -> TwoPSet a -> Bool)
-> (TwoPSet a -> TwoPSet a -> Bool) -> Eq (TwoPSet a)
forall a. Eq a => TwoPSet a -> TwoPSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TwoPSet a -> TwoPSet a -> Bool
$c/= :: forall a. Eq a => TwoPSet a -> TwoPSet a -> Bool
== :: TwoPSet a -> TwoPSet a -> Bool
$c== :: forall a. Eq a => TwoPSet a -> TwoPSet a -> Bool
Eq, Int -> TwoPSet a -> ShowS
[TwoPSet a] -> ShowS
TwoPSet a -> String
(Int -> TwoPSet a -> ShowS)
-> (TwoPSet a -> String)
-> ([TwoPSet a] -> ShowS)
-> Show (TwoPSet a)
forall a. Show a => Int -> TwoPSet a -> ShowS
forall a. Show a => [TwoPSet a] -> ShowS
forall a. Show a => TwoPSet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwoPSet a] -> ShowS
$cshowList :: forall a. Show a => [TwoPSet a] -> ShowS
show :: TwoPSet a -> String
$cshow :: forall a. Show a => TwoPSet a -> String
showsPrec :: Int -> TwoPSet a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TwoPSet a -> ShowS
Show)

instance Ord a => CmRDT (TwoPSet a) where
    type Payload (TwoPSet a) = Map a Bool

    initial :: Payload (TwoPSet a)
initial = Payload (TwoPSet a)
forall k a. Map k a
Map.empty

    makeOp :: Intent (TwoPSet a) -> Payload (TwoPSet a) -> Maybe (m (TwoPSet a))
makeOp Intent (TwoPSet a)
op Payload (TwoPSet a)
payload = case Intent (TwoPSet a)
op of
        Add    _ -> m (TwoPSet a) -> Maybe (m (TwoPSet a))
forall a. a -> Maybe a
Just (m (TwoPSet a) -> Maybe (m (TwoPSet a)))
-> m (TwoPSet a) -> Maybe (m (TwoPSet a))
forall a b. (a -> b) -> a -> b
$ TwoPSet a -> m (TwoPSet a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Intent (TwoPSet a)
TwoPSet a
op
        Remove a
            | a -> Bool
isKnown a
a -> m (TwoPSet a) -> Maybe (m (TwoPSet a))
forall a. a -> Maybe a
Just (m (TwoPSet a) -> Maybe (m (TwoPSet a)))
-> m (TwoPSet a) -> Maybe (m (TwoPSet a))
forall a b. (a -> b) -> a -> b
$ TwoPSet a -> m (TwoPSet a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Intent (TwoPSet a)
TwoPSet a
op
            | Bool
otherwise -> Maybe (m (TwoPSet a))
forall a. Maybe a
Nothing
      where
        isKnown :: a -> Bool
isKnown a
a = a -> Map a Bool -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member a
a Map a Bool
Payload (TwoPSet a)
payload

    apply :: TwoPSet a -> Payload (TwoPSet a) -> Payload (TwoPSet a)
apply = \case
        Add    a
a -> (Bool -> Bool -> Bool) -> a -> Bool -> Map a Bool -> Map a Bool
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Bool -> Bool -> Bool
(&&) a
a Bool
True
        Remove a
a -> a -> Bool -> Map a Bool -> Map a Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert          a
a Bool
False

instance Eq a => CausalOrd (TwoPSet a) where
    Add a
b precedes :: TwoPSet a -> TwoPSet a -> Bool
`precedes` Remove a
a = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b -- `Remove e` can occur only after `Add e`
    TwoPSet a
_     `precedes` TwoPSet a
_        = Bool
False  -- Any other are not ordered