module Events.Toggle(
Toggle,
newToggle,
toggle1,
toggle2,
ifToggle,
peekToggle,
SimpleToggle,
newSimpleToggle,
simpleToggle,
ifSimpleToggle,
) where
import Control.Concurrent
import Util.Computation
import Util.Object
newtype SimpleToggle = SimpleToggle (MVar Bool)
newSimpleToggle :: IO SimpleToggle
newSimpleToggle :: IO SimpleToggle
newSimpleToggle =
do
MVar Bool
mVar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
True
SimpleToggle -> IO SimpleToggle
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar Bool -> SimpleToggle
SimpleToggle MVar Bool
mVar)
simpleToggle :: SimpleToggle -> IO Bool
simpleToggle :: SimpleToggle -> IO Bool
simpleToggle (SimpleToggle MVar Bool
mVar) =
do
Bool
oldVal <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
mVar
MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
mVar Bool
False
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
oldVal
ifSimpleToggle :: SimpleToggle -> IO () -> IO ()
ifSimpleToggle :: SimpleToggle -> IO () -> IO ()
ifSimpleToggle SimpleToggle
sToggle IO ()
action =
do
Bool
goAhead <- SimpleToggle -> IO Bool
simpleToggle SimpleToggle
sToggle
if Bool
goAhead then IO ()
action else IO ()
forall (m :: * -> *). Monad m => m ()
done
simpleToggle2 :: SimpleToggle -> SimpleToggle -> IO (Maybe (Bool,Bool))
simpleToggle2 :: SimpleToggle -> SimpleToggle -> IO (Maybe (Bool, Bool))
simpleToggle2 (SimpleToggle MVar Bool
mVar1) (SimpleToggle MVar Bool
mVar2) =
do
Bool
oldVal1 <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
mVar1
Bool
oldVal2 <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
mVar2
if (Bool
oldVal1 Bool -> Bool -> Bool
&& Bool
oldVal2)
then
do
MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
mVar2 Bool
False
MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
mVar1 Bool
False
Maybe (Bool, Bool) -> IO (Maybe (Bool, Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Bool, Bool)
forall a. Maybe a
Nothing
else
do
MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
mVar2 Bool
oldVal2
MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
mVar1 Bool
oldVal1
Maybe (Bool, Bool) -> IO (Maybe (Bool, Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
oldVal1,Bool
oldVal2))
peekSimpleToggle :: SimpleToggle -> IO Bool
peekSimpleToggle :: SimpleToggle -> IO Bool
peekSimpleToggle (SimpleToggle MVar Bool
mVar) = MVar Bool -> IO Bool
forall a. MVar a -> IO a
readMVar MVar Bool
mVar
data Toggle = Toggle !ObjectID !SimpleToggle
newToggle :: IO Toggle
newToggle :: IO Toggle
newToggle =
do
ObjectID
uniqVal <- IO ObjectID
newObject
SimpleToggle
stoggle <- IO SimpleToggle
newSimpleToggle
Toggle -> IO Toggle
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjectID -> SimpleToggle -> Toggle
Toggle ObjectID
uniqVal SimpleToggle
stoggle)
toggle1 :: Toggle -> IO Bool
toggle1 :: Toggle -> IO Bool
toggle1 (Toggle ObjectID
_ SimpleToggle
stoggle) = SimpleToggle -> IO Bool
simpleToggle SimpleToggle
stoggle
ifToggle :: Toggle -> IO () -> IO ()
ifToggle :: Toggle -> IO () -> IO ()
ifToggle Toggle
toggle IO ()
action =
do
Bool
goAhead <- Toggle -> IO Bool
toggle1 Toggle
toggle
if Bool
goAhead then IO ()
action else IO ()
forall (m :: * -> *). Monad m => m ()
done
toggle2 :: Toggle -> Toggle -> IO(Maybe(Bool,Bool))
toggle2 :: Toggle -> Toggle -> IO (Maybe (Bool, Bool))
toggle2 (Toggle ObjectID
unique1 SimpleToggle
stoggle1) (Toggle ObjectID
unique2 SimpleToggle
stoggle2) =
case ObjectID -> ObjectID -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ObjectID
unique1 ObjectID
unique2 of
Ordering
LT -> SimpleToggle -> SimpleToggle -> IO (Maybe (Bool, Bool))
simpleToggle2 SimpleToggle
stoggle1 SimpleToggle
stoggle2
Ordering
GT ->
do
Maybe (Bool, Bool)
result <- SimpleToggle -> SimpleToggle -> IO (Maybe (Bool, Bool))
simpleToggle2 SimpleToggle
stoggle2 SimpleToggle
stoggle1
case Maybe (Bool, Bool)
result of
Maybe (Bool, Bool)
Nothing -> Maybe (Bool, Bool) -> IO (Maybe (Bool, Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Bool, Bool)
forall a. Maybe a
Nothing
Just (Bool
r1,Bool
r2) -> Maybe (Bool, Bool) -> IO (Maybe (Bool, Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
r2,Bool
r1))
Ordering
EQ ->
do
Bool
r <- SimpleToggle -> IO Bool
peekSimpleToggle SimpleToggle
stoggle1
Maybe (Bool, Bool) -> IO (Maybe (Bool, Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
r,Bool
r))
peekToggle :: Toggle -> IO Bool
peekToggle :: Toggle -> IO Bool
peekToggle (Toggle ObjectID
_ SimpleToggle
sToggle) = SimpleToggle -> IO Bool
peekSimpleToggle SimpleToggle
sToggle
{-# INLINE newToggle #-}
{-# INLINE toggle1 #-}
{-# INLINE toggle2 #-}
{-# INLINE peekToggle #-}
{-# INLINE newSimpleToggle #-}
{-# INLINE simpleToggle #-}
{-# INLINE simpleToggle2 #-}