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 =
do
mVar <- newMVar True
return (SimpleToggle mVar)
simpleToggle :: SimpleToggle -> IO Bool
simpleToggle (SimpleToggle mVar) =
do
oldVal <- takeMVar mVar
putMVar mVar False
return oldVal
ifSimpleToggle :: SimpleToggle -> IO () -> IO ()
ifSimpleToggle sToggle action =
do
goAhead <- simpleToggle sToggle
if goAhead then action else done
simpleToggle2 :: SimpleToggle -> SimpleToggle -> IO (Maybe (Bool,Bool))
simpleToggle2 (SimpleToggle mVar1) (SimpleToggle mVar2) =
do
oldVal1 <- takeMVar mVar1
oldVal2 <- takeMVar mVar2
if (oldVal1 && oldVal2)
then
do
putMVar mVar2 False
putMVar mVar1 False
return Nothing
else
do
putMVar mVar2 oldVal2
putMVar mVar1 oldVal1
return (Just (oldVal1,oldVal2))
peekSimpleToggle :: SimpleToggle -> IO Bool
peekSimpleToggle (SimpleToggle mVar) = readMVar mVar
data Toggle = Toggle !ObjectID !SimpleToggle
newToggle :: IO Toggle
newToggle =
do
uniqVal <- newObject
stoggle <- newSimpleToggle
return (Toggle uniqVal stoggle)
toggle1 :: Toggle -> IO Bool
toggle1 (Toggle _ stoggle) = simpleToggle stoggle
ifToggle :: Toggle -> IO () -> IO ()
ifToggle toggle action =
do
goAhead <- toggle1 toggle
if goAhead then action else done
toggle2 :: Toggle -> Toggle -> IO(Maybe(Bool,Bool))
toggle2 (Toggle unique1 stoggle1) (Toggle unique2 stoggle2) =
case compare unique1 unique2 of
LT -> simpleToggle2 stoggle1 stoggle2
GT ->
do
result <- simpleToggle2 stoggle2 stoggle1
case result of
Nothing -> return Nothing
Just (r1,r2) -> return (Just (r2,r1))
EQ ->
do
r <- peekSimpleToggle stoggle1
return (Just (r,r))
peekToggle :: Toggle -> IO Bool
peekToggle (Toggle _ sToggle) = peekSimpleToggle sToggle