{-# LANGUAGE TypeFamilies #-}
{- | The type @R (Dual Bool)@ is ike 'Bool', but allows recursive definitions:

>>> :{
  let s1 = rInsert 23 s2
      s2 = rInsert 42 s1
  in getR s1
 :}
fromList [23,42]

-}
module Data.Recursive.Set
  ( R
  , mkR
  , getR
  , module Data.Recursive.Set
  ) where

import qualified Data.Set as S
import Data.Coerce
import Data.Monoid
import Control.Monad

import Data.Recursive.R.Internal
import Data.Recursive.Propagator.Naive
import Data.Recursive.Propagator.P2

-- $setup
-- >>> :set -XFlexibleInstances
-- >>> :set -XScopedTypeVariables
-- >>> import Test.QuickCheck
-- >>> instance (Ord a, Arbitrary a) => Arbitrary (R (S.Set a)) where arbitrary = mkR <$> arbitrary
-- >>> instance (Eq a, Show a) => Show (R (S.Set a)) where show = show . getR

-- | prop> getR rEmpty === S.empty
rEmpty :: Eq a => R (S.Set a)
rEmpty :: forall a. Eq a => R (Set a)
rEmpty = forall a. HasPropagator a => a -> R a
mkR forall a. Set a
S.empty

-- | prop> getR (rInsert n r1) === S.insert n (getR r1)
rInsert :: Ord a => a -> R (S.Set a) -> R (S.Set a)
rInsert :: forall a. Ord a => a -> R (Set a) -> R (Set a)
rInsert a
x = forall a b.
(HasPropagator a, HasPropagator b) =>
(Prop a -> Prop b -> IO ()) -> R a -> R b
defR1 forall a b. (a -> b) -> a -> b
$ forall b a. Eq b => (a -> b) -> Prop a -> Prop b -> IO ()
lift1 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
S.insert a
x

-- | prop> getR (rDelete n r1) === S.delete n (getR r1)
rDelete :: Ord a => a -> R (S.Set a) -> R (S.Set a)
rDelete :: forall a. Ord a => a -> R (Set a) -> R (Set a)
rDelete a
x = forall a b.
(HasPropagator a, HasPropagator b) =>
(Prop a -> Prop b -> IO ()) -> R a -> R b
defR1 forall a b. (a -> b) -> a -> b
$ forall b a. Eq b => (a -> b) -> Prop a -> Prop b -> IO ()
lift1 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
S.delete a
x

-- | prop> \(Fun _ p) -> getR (rFilter p r1) === S.filter p (getR r1)
rFilter :: Ord a => (a -> Bool) -> R (S.Set a) -> R (S.Set a)
rFilter :: forall a. Ord a => (a -> Bool) -> R (Set a) -> R (Set a)
rFilter a -> Bool
f = forall a b.
(HasPropagator a, HasPropagator b) =>
(Prop a -> Prop b -> IO ()) -> R a -> R b
defR1 forall a b. (a -> b) -> a -> b
$ forall b a. Eq b => (a -> b) -> Prop a -> Prop b -> IO ()
lift1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Set a -> Set a
S.filter a -> Bool
f

-- | prop> getR (rUnion r1 r2) === S.union (getR r1) (getR r2)
rUnion :: Ord a => R (S.Set a) -> R (S.Set a) -> R (S.Set a)
rUnion :: forall a. Ord a => R (Set a) -> R (Set a) -> R (Set a)
rUnion = forall a b c.
(HasPropagator a, HasPropagator b, HasPropagator c) =>
(Prop a -> Prop b -> Prop c -> IO ()) -> R a -> R b -> R c
defR2 forall a b. (a -> b) -> a -> b
$ forall c a b.
Eq c =>
(a -> b -> c) -> Prop a -> Prop b -> Prop c -> IO ()
lift2 forall a. Ord a => Set a -> Set a -> Set a
S.union

-- | prop> getR (rUnions rs) === S.unions (map getR rs)
rUnions :: Ord a => [R (S.Set a)] -> R (S.Set a)
rUnions :: forall a. Ord a => [R (Set a)] -> R (Set a)
rUnions = forall a b.
(HasPropagator a, HasPropagator b) =>
([Prop a] -> Prop b -> IO ()) -> [R a] -> R b
defRList forall a b. (a -> b) -> a -> b
$ forall b a. Eq b => ([a] -> b) -> [Prop a] -> Prop b -> IO ()
liftList forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions

-- | prop> getR (rIntersection r1 r2) === S.intersection (getR r1) (getR r2)
rIntersection :: Ord a => R (S.Set a) -> R (S.Set a) -> R (S.Set a)
rIntersection :: forall a. Ord a => R (Set a) -> R (Set a) -> R (Set a)
rIntersection = forall a b c.
(HasPropagator a, HasPropagator b, HasPropagator c) =>
(Prop a -> Prop b -> Prop c -> IO ()) -> R a -> R b -> R c
defR2 forall a b. (a -> b) -> a -> b
$ forall c a b.
Eq c =>
(a -> b -> c) -> Prop a -> Prop b -> Prop c -> IO ()
lift2 forall a. Ord a => Set a -> Set a -> Set a
S.intersection

-- | prop> getR (rMember n r1) === S.member n (getR r1)
rMember :: Ord a => a -> R (S.Set a) -> R Bool
rMember :: forall a. Ord a => a -> R (Set a) -> R Bool
rMember a
x = forall a b.
(HasPropagator a, HasPropagator b) =>
(Prop a -> Prop b -> IO ()) -> R a -> R b
defR1 forall a b. (a -> b) -> a -> b
$ \Prop (Set a)
ps Prop Bool
pb -> do
    let update :: IO ()
update = do
            Set a
s <- forall a. Prop a -> IO a
readProp Prop (Set a)
ps
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Ord a => a -> Set a -> Bool
S.member a
x Set a
s) forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce P2 -> IO ()
setTop Prop Bool
pb
    forall a. Prop a -> IO () -> IO ()
watchProp Prop (Set a)
ps IO ()
update
    IO ()
update

-- | prop> getRDual (rNotMember n r1) === S.notMember n (getR r1)
rNotMember :: Ord a => a -> R (S.Set a) -> R (Dual Bool)
rNotMember :: forall a. Ord a => a -> R (Set a) -> R (Dual Bool)
rNotMember a
x = forall a b.
(HasPropagator a, HasPropagator b) =>
(Prop a -> Prop b -> IO ()) -> R a -> R b
defR1 forall a b. (a -> b) -> a -> b
$ \Prop (Set a)
ps Prop (Dual Bool)
pb -> do
    let update :: IO ()
update = do
            Set a
s <- forall a. Prop a -> IO a
readProp Prop (Set a)
ps
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Ord a => a -> Set a -> Bool
S.member a
x Set a
s) forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce P2 -> IO ()
setTop Prop (Dual Bool)
pb
    forall a. Prop a -> IO () -> IO ()
watchProp Prop (Set a)
ps IO ()
update
    IO ()
update

-- | prop> getRDual (rDisjoint r1 r2) === S.disjoint (getR r1) (getR r2)
rDisjoint :: Ord a => R (S.Set a) -> R (S.Set a) -> R (Dual Bool)
rDisjoint :: forall a. Ord a => R (Set a) -> R (Set a) -> R (Dual Bool)
rDisjoint = forall a b c.
(HasPropagator a, HasPropagator b, HasPropagator c) =>
(Prop a -> Prop b -> Prop c -> IO ()) -> R a -> R b -> R c
defR2 forall a b. (a -> b) -> a -> b
$ \Prop (Set a)
ps1 Prop (Set a)
ps2 (PDualBool P2
pb) -> do
    let update :: IO ()
update = do
            Set a
s1 <- forall a. Prop a -> IO a
readProp Prop (Set a)
ps1
            Set a
s2 <- forall a. Prop a -> IO a
readProp Prop (Set a)
ps2
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Ord a => Set a -> Set a -> Bool
S.disjoint Set a
s1 Set a
s2) forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce P2 -> IO ()
setTop P2
pb
    forall a. Prop a -> IO () -> IO ()
watchProp Prop (Set a)
ps1 IO ()
update
    forall a. Prop a -> IO () -> IO ()
watchProp Prop (Set a)
ps2 IO ()
update
    IO ()
update