{-# LANGUAGE TypeFamilies #-}
module Data.Recursive.Set (RSet, module Data.Recursive.Set) where
import qualified Data.Set as S
import Control.Monad hiding (when)
import Data.Recursive.Internal
import qualified Data.Propagator.Purify as Purify
import Data.Propagator.Naive
import Data.Propagator.P2
get :: RSet a -> S.Set a
get :: forall a. RSet a -> Set a
get (RSet Purify (Prop (Set a))
p) = Purify (Prop (Set a)) -> Set a
forall pa a. Propagator pa a => Purify pa -> a
Purify.get Purify (Prop (Set a))
p
mk :: S.Set a -> RSet a
mk :: forall a. Set a -> RSet a
mk Set a
s = Purify (Prop (Set a)) -> RSet a
forall a. Purify (Prop (Set a)) -> RSet a
RSet (Purify (Prop (Set a)) -> RSet a)
-> Purify (Prop (Set a)) -> RSet a
forall a b. (a -> b) -> a -> b
$ Set a -> Purify (Prop (Set a))
forall p a. Propagator p a => a -> Purify p
Purify.mk Set a
s
empty :: RSet a
empty :: forall a. RSet a
empty = Purify (Prop (Set a)) -> RSet a
forall a. Purify (Prop (Set a)) -> RSet a
RSet (Purify (Prop (Set a)) -> RSet a)
-> Purify (Prop (Set a)) -> RSet a
forall a b. (a -> b) -> a -> b
$ Set a -> Purify (Prop (Set a))
forall p a. Propagator p a => a -> Purify p
Purify.mk Set a
forall a. Set a
S.empty
singleton :: a -> RSet a
singleton :: forall a. a -> RSet a
singleton a
x = Purify (Prop (Set a)) -> RSet a
forall a. Purify (Prop (Set a)) -> RSet a
RSet (Purify (Prop (Set a)) -> RSet a)
-> Purify (Prop (Set a)) -> RSet a
forall a b. (a -> b) -> a -> b
$ Set a -> Purify (Prop (Set a))
forall p a. Propagator p a => a -> Purify p
Purify.mk (Set a -> Purify (Prop (Set a))) -> Set a -> Purify (Prop (Set a))
forall a b. (a -> b) -> a -> b
$ a -> Set a
forall a. a -> Set a
S.singleton a
x
insert :: Ord a => a -> RSet a -> RSet a
insert :: forall a. Ord a => a -> RSet a -> RSet a
insert a
x = OpenR (RSet a -> RSet a) -> RSet a -> RSet a
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RSet a) -> RSet a -> RSet a)
-> OpenR (RSet a -> RSet a) -> RSet a -> RSet a
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a))
forall pa a pb b.
(Propagator pa a, Propagator pb b) =>
(pa -> pb -> IO ()) -> Purify pa -> Purify pb
Purify.def1 ((Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a)))
-> (Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall b a. POrder b => (a -> b) -> Prop a -> Prop b -> IO ()
lift1 ((Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ())
-> (Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
x
delete :: Ord a => a -> RSet a -> RSet a
delete :: forall a. Ord a => a -> RSet a -> RSet a
delete a
x = OpenR (RSet a -> RSet a) -> RSet a -> RSet a
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RSet a) -> RSet a -> RSet a)
-> OpenR (RSet a -> RSet a) -> RSet a -> RSet a
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a))
forall pa a pb b.
(Propagator pa a, Propagator pb b) =>
(pa -> pb -> IO ()) -> Purify pa -> Purify pb
Purify.def1 ((Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a)))
-> (Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall b a. POrder b => (a -> b) -> Prop a -> Prop b -> IO ()
lift1 ((Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ())
-> (Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete a
x
filter :: Ord a => (a -> Bool) -> RSet a -> RSet a
filter :: forall a. Ord a => (a -> Bool) -> RSet a -> RSet a
filter a -> Bool
f = OpenR (RSet a -> RSet a) -> RSet a -> RSet a
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RSet a) -> RSet a -> RSet a)
-> OpenR (RSet a -> RSet a) -> RSet a -> RSet a
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a))
forall pa a pb b.
(Propagator pa a, Propagator pb b) =>
(pa -> pb -> IO ()) -> Purify pa -> Purify pb
Purify.def1 ((Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a)))
-> (Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall b a. POrder b => (a -> b) -> Prop a -> Prop b -> IO ()
lift1 ((Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ())
-> (Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
S.filter a -> Bool
f
union :: Ord a => RSet a -> RSet a -> RSet a
union :: forall a. Ord a => RSet a -> RSet a -> RSet a
union = OpenR (RSet a -> RSet a -> RSet a) -> RSet a -> RSet a -> RSet a
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RSet a -> RSet a) -> RSet a -> RSet a -> RSet a)
-> OpenR (RSet a -> RSet a -> RSet a) -> RSet a -> RSet a -> RSet a
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
forall pa a pb b pc c.
(Propagator pa a, Propagator pb b, Propagator pc c) =>
(pa -> pb -> pc -> IO ()) -> Purify pa -> Purify pb -> Purify pc
Purify.def2 ((Prop (Set a) -> Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
-> Purify (Prop (Set a)))
-> (Prop (Set a) -> Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a -> Set a)
-> Prop (Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall c a b.
POrder c =>
(a -> b -> c) -> Prop a -> Prop b -> Prop c -> IO ()
lift2 Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union
unions :: Ord a => [RSet a] -> RSet a
unions :: forall a. Ord a => [RSet a] -> RSet a
unions = OpenR ([RSet a] -> RSet a) -> [RSet a] -> RSet a
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR ([RSet a] -> RSet a) -> [RSet a] -> RSet a)
-> OpenR ([RSet a] -> RSet a) -> [RSet a] -> RSet a
forall a b. (a -> b) -> a -> b
$ ([Prop (Set a)] -> Prop (Set a) -> IO ())
-> [Purify (Prop (Set a))] -> Purify (Prop (Set a))
forall pa a pb b.
(Propagator pa a, Propagator pb b) =>
([pa] -> pb -> IO ()) -> [Purify pa] -> Purify pb
Purify.defList (([Prop (Set a)] -> Prop (Set a) -> IO ())
-> [Purify (Prop (Set a))] -> Purify (Prop (Set a)))
-> ([Prop (Set a)] -> Prop (Set a) -> IO ())
-> [Purify (Prop (Set a))]
-> Purify (Prop (Set a))
forall a b. (a -> b) -> a -> b
$ ([Set a] -> Set a) -> [Prop (Set a)] -> Prop (Set a) -> IO ()
forall b a. POrder b => ([a] -> b) -> [Prop a] -> Prop b -> IO ()
liftList [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions
intersection :: Ord a => RSet a -> RSet a -> RSet a
intersection :: forall a. Ord a => RSet a -> RSet a -> RSet a
intersection = OpenR (RSet a -> RSet a -> RSet a) -> RSet a -> RSet a -> RSet a
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RSet a -> RSet a) -> RSet a -> RSet a -> RSet a)
-> OpenR (RSet a -> RSet a -> RSet a) -> RSet a -> RSet a -> RSet a
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
forall pa a pb b pc c.
(Propagator pa a, Propagator pb b, Propagator pc c) =>
(pa -> pb -> pc -> IO ()) -> Purify pa -> Purify pb -> Purify pc
Purify.def2 ((Prop (Set a) -> Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
-> Purify (Prop (Set a)))
-> (Prop (Set a) -> Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a -> Set a)
-> Prop (Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall c a b.
POrder c =>
(a -> b -> c) -> Prop a -> Prop b -> Prop c -> IO ()
lift2 Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.intersection
member :: Ord a => a -> RSet a -> RBool
member :: forall a. Ord a => a -> RSet a -> RBool
member a
x = OpenR (RSet a -> RBool) -> RSet a -> RBool
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RBool) -> RSet a -> RBool)
-> OpenR (RSet a -> RBool) -> RSet a -> RBool
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> P2 -> IO ()) -> Purify (Prop (Set a)) -> Purify P2
forall pa a pb b.
(Propagator pa a, Propagator pb b) =>
(pa -> pb -> IO ()) -> Purify pa -> Purify pb
Purify.def1 ((Prop (Set a) -> P2 -> IO ())
-> Purify (Prop (Set a)) -> Purify P2)
-> (Prop (Set a) -> P2 -> IO ())
-> Purify (Prop (Set a))
-> Purify P2
forall a b. (a -> b) -> a -> b
$ \Prop (Set a)
ps P2
pb -> do
let update :: IO ()
update = do
Set a
s <- Prop (Set a) -> IO (Set a)
forall a. Prop a -> IO a
readProp Prop (Set a)
ps
if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
x Set a
s then P2 -> IO ()
setTop P2
pb else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Prop (Set a) -> IO () -> IO ()
forall a. Prop a -> IO () -> IO ()
watchProp Prop (Set a)
ps IO ()
update
IO ()
update
notMember :: Ord a => a -> RSet a -> RDualBool
notMember :: forall a. Ord a => a -> RSet a -> RDualBool
notMember a
x = OpenR (RSet a -> RDualBool) -> RSet a -> RDualBool
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RDualBool) -> RSet a -> RDualBool)
-> OpenR (RSet a -> RDualBool) -> RSet a -> RDualBool
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> P2 -> IO ()) -> Purify (Prop (Set a)) -> Purify P2
forall pa a pb b.
(Propagator pa a, Propagator pb b) =>
(pa -> pb -> IO ()) -> Purify pa -> Purify pb
Purify.def1 ((Prop (Set a) -> P2 -> IO ())
-> Purify (Prop (Set a)) -> Purify P2)
-> (Prop (Set a) -> P2 -> IO ())
-> Purify (Prop (Set a))
-> Purify P2
forall a b. (a -> b) -> a -> b
$ \Prop (Set a)
ps P2
pb -> do
let update :: IO ()
update = do
Set a
s <- Prop (Set a) -> IO (Set a)
forall a. Prop a -> IO a
readProp Prop (Set a)
ps
if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
x Set a
s then P2 -> IO ()
setTop P2
pb else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Prop (Set a) -> IO () -> IO ()
forall a. Prop a -> IO () -> IO ()
watchProp Prop (Set a)
ps IO ()
update
IO ()
update
null :: RSet a -> RDualBool
null :: forall a. RSet a -> RDualBool
null = OpenR (RSet a -> RDualBool) -> RSet a -> RDualBool
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RDualBool) -> RSet a -> RDualBool)
-> OpenR (RSet a -> RDualBool) -> RSet a -> RDualBool
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> P2 -> IO ()) -> Purify (Prop (Set a)) -> Purify P2
forall pa a pb b.
(Propagator pa a, Propagator pb b) =>
(pa -> pb -> IO ()) -> Purify pa -> Purify pb
Purify.def1 ((Prop (Set a) -> P2 -> IO ())
-> Purify (Prop (Set a)) -> Purify P2)
-> (Prop (Set a) -> P2 -> IO ())
-> Purify (Prop (Set a))
-> Purify P2
forall a b. (a -> b) -> a -> b
$ \Prop (Set a)
ps P2
pb -> do
let update :: IO ()
update = do
Set a
s <- Prop (Set a) -> IO (Set a)
forall a. Prop a -> IO a
readProp Prop (Set a)
ps
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set a -> Bool
forall a. Set a -> Bool
S.null Set a
s) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ P2 -> IO ()
setTop P2
pb
Prop (Set a) -> IO () -> IO ()
forall a. Prop a -> IO () -> IO ()
watchProp Prop (Set a)
ps IO ()
update
IO ()
update
disjoint :: Ord a => RSet a -> RSet a -> RDualBool
disjoint :: forall a. Ord a => RSet a -> RSet a -> RDualBool
disjoint = OpenR (RSet a -> RSet a -> RDualBool)
-> RSet a -> RSet a -> RDualBool
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RSet a -> RDualBool)
-> RSet a -> RSet a -> RDualBool)
-> OpenR (RSet a -> RSet a -> RDualBool)
-> RSet a
-> RSet a
-> RDualBool
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> Prop (Set a) -> P2 -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a)) -> Purify P2
forall pa a pb b pc c.
(Propagator pa a, Propagator pb b, Propagator pc c) =>
(pa -> pb -> pc -> IO ()) -> Purify pa -> Purify pb -> Purify pc
Purify.def2 ((Prop (Set a) -> Prop (Set a) -> P2 -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a)) -> Purify P2)
-> (Prop (Set a) -> Prop (Set a) -> P2 -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
-> Purify P2
forall a b. (a -> b) -> a -> b
$ \Prop (Set a)
ps1 Prop (Set a)
ps2 P2
pb -> do
let update :: IO ()
update = do
Set a
s1 <- Prop (Set a) -> IO (Set a)
forall a. Prop a -> IO a
readProp Prop (Set a)
ps1
Set a
s2 <- Prop (Set a) -> IO (Set a)
forall a. Prop a -> IO a
readProp Prop (Set a)
ps2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.disjoint Set a
s1 Set a
s2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ P2 -> IO ()
setTop P2
pb
Prop (Set a) -> IO () -> IO ()
forall a. Prop a -> IO () -> IO ()
watchProp Prop (Set a)
ps1 IO ()
update
Prop (Set a) -> IO () -> IO ()
forall a. Prop a -> IO () -> IO ()
watchProp Prop (Set a)
ps2 IO ()
update
IO ()
update
when :: RBool -> RSet a -> RSet a
when :: forall a. RBool -> RSet a -> RSet a
when = OpenR (RBool -> RSet a -> RSet a) -> RBool -> RSet a -> RSet a
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RBool -> RSet a -> RSet a) -> RBool -> RSet a -> RSet a)
-> OpenR (RBool -> RSet a -> RSet a) -> RBool -> RSet a -> RSet a
forall a b. (a -> b) -> a -> b
$ (P2 -> Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify P2 -> Purify (Prop (Set a)) -> Purify (Prop (Set a))
forall pa a pb b pc c.
(Propagator pa a, Propagator pb b, Propagator pc c) =>
(pa -> pb -> pc -> IO ()) -> Purify pa -> Purify pb -> Purify pc
Purify.def2 ((P2 -> Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify P2 -> Purify (Prop (Set a)) -> Purify (Prop (Set a)))
-> (P2 -> Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify P2
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
forall a b. (a -> b) -> a -> b
$ \P2
pb Prop (Set a)
ps1 Prop (Set a)
ps2 -> do
P2 -> IO () -> IO ()
whenTop P2
pb (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall b a. POrder b => (a -> b) -> Prop a -> Prop b -> IO ()
lift1 Set a -> Set a
forall a. a -> a
Prelude.id Prop (Set a)
ps1 Prop (Set a)
ps2
id :: RSet a -> RSet a
id :: forall a. RSet a -> RSet a
id = OpenR (RSet a -> RSet a) -> RSet a -> RSet a
forall a. Coercible a (OpenR a) => OpenR a -> a
openR (OpenR (RSet a -> RSet a) -> RSet a -> RSet a)
-> OpenR (RSet a -> RSet a) -> RSet a -> RSet a
forall a b. (a -> b) -> a -> b
$ (Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a))
forall pa a pb b.
(Propagator pa a, Propagator pb b) =>
(pa -> pb -> IO ()) -> Purify pa -> Purify pb
Purify.def1 ((Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a)) -> Purify (Prop (Set a)))
-> (Prop (Set a) -> Prop (Set a) -> IO ())
-> Purify (Prop (Set a))
-> Purify (Prop (Set a))
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a) -> Prop (Set a) -> Prop (Set a) -> IO ()
forall b a. POrder b => (a -> b) -> Prop a -> Prop b -> IO ()
lift1 Set a -> Set a
forall a. a -> a
Prelude.id