module CRDT.Cv.TwoPSet
    ( TwoPSet (..)
    , add
    , initial
    , member
    , remove
    , singleton
    , isKnown
    ) where

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

import           Data.Semilattice (Semilattice)

newtype TwoPSet a = TwoPSet (Map a Bool)
    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 => Semigroup (TwoPSet a) where
    TwoPSet Map a Bool
m1 <> :: TwoPSet a -> TwoPSet a -> TwoPSet a
<> TwoPSet Map a Bool
m2 = Map a Bool -> TwoPSet a
forall a. Map a Bool -> TwoPSet a
TwoPSet ((Bool -> Bool -> Bool) -> Map a Bool -> Map a Bool -> Map a Bool
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Bool -> Bool -> Bool
(&&) Map a Bool
m1 Map a Bool
m2)

instance Ord a => Semilattice (TwoPSet a)

add :: Ord a => a -> TwoPSet a -> TwoPSet a
add :: a -> TwoPSet a -> TwoPSet a
add a
e (TwoPSet Map a Bool
m) = Map a Bool -> TwoPSet a
forall a. Map a Bool -> TwoPSet a
TwoPSet ((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
e Bool
True Map a Bool
m)

initial :: TwoPSet a
initial :: TwoPSet a
initial = Map a Bool -> TwoPSet a
forall a. Map a Bool -> TwoPSet a
TwoPSet Map a Bool
forall k a. Map k a
Map.empty

member :: Ord a => a -> TwoPSet a -> Bool
member :: a -> TwoPSet a -> Bool
member a
e (TwoPSet Map a Bool
m) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Map a Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
e Map a Bool
m

remove :: Ord a => a -> TwoPSet a -> TwoPSet a
remove :: a -> TwoPSet a -> TwoPSet a
remove a
e (TwoPSet Map a Bool
m) = Map a Bool -> TwoPSet a
forall a. Map a Bool -> TwoPSet a
TwoPSet (Map a Bool -> TwoPSet a) -> Map a Bool -> TwoPSet a
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> a -> Map a Bool -> Map a Bool
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
False) a
e Map a Bool
m

singleton :: Ord a => a -> TwoPSet a
singleton :: a -> TwoPSet a
singleton a
a = a -> TwoPSet a -> TwoPSet a
forall a. Ord a => a -> TwoPSet a -> TwoPSet a
add a
a TwoPSet a
forall a. TwoPSet a
initial

-- | XXX Internal
isKnown :: Ord a => a -> TwoPSet a -> Bool
isKnown :: a -> TwoPSet a -> Bool
isKnown a
e (TwoPSet Map a Bool
m) = a -> Map a Bool -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member a
e Map a Bool
m