-- | A trivial mutex.

module Data.Mutex where

import Prelude
import Data.Var

data Mutex = Mutex (Var Bool)

-- | Make a new unlocked mutex.
newMutex :: Fay Mutex
newMutex :: Fay Mutex
newMutex = do Ptr (Var Bool)
v <- Bool -> Fay (Ptr (Var Bool))
forall a. Ptr a -> Fay (Ptr (Var (Ptr a)))
newVar Bool
False
              Mutex -> Fay Mutex
forall a. a -> Fay a
return (Ptr (Var Bool) -> Mutex
Mutex Ptr (Var Bool)
v)

-- | If a mutex is free run the action, otherwise don't.
ifMutexFree :: Mutex -> Fay () -> Fay ()
ifMutexFree :: Mutex -> Fay () -> Fay ()
ifMutexFree (Mutex Ptr (Var Bool)
var) Fay ()
action = do
  Bool
locked <- Ptr (Var Bool) -> Fay Bool
forall (v :: * -> *) a. Gettable (v a) => v a -> Fay a
get Ptr (Var Bool)
var
  if Bool
locked then () -> Fay ()
forall a. a -> Fay a
return () else Fay ()
action

-- | Wait until the mutex is free to do something.
whenMutexFree :: Mutex -> Fay () -> Fay ()
whenMutexFree :: Mutex -> Fay () -> Fay ()
whenMutexFree (Mutex Ptr (Var Bool)
var) Fay ()
cont = do
  Bool
locked <- Ptr (Var Bool) -> Fay Bool
forall (v :: * -> *) a. Gettable (v a) => v a -> Fay a
get Ptr (Var Bool)
var
  if Bool
locked
     then do () -> Fay ()
_ <- ((Bool -> Fay ()) -> Fay (() -> Fay ()))
-> ((() -> Fay ()) -> Bool -> Fay ()) -> Fay (() -> Fay ())
forall a.
((a -> Fay ()) -> Fay (() -> Fay ()))
-> ((() -> Fay ()) -> a -> Fay ()) -> Fay (() -> Fay ())
withUnsubscriber
                    (Ptr (Var Bool) -> (Bool -> Fay ()) -> Fay (() -> Fay ())
forall (v :: * -> *) a void.
Subscribable (v a) =>
v a -> Ptr (a -> Fay void) -> Fay (() -> Fay ())
subscribe Ptr (Var Bool)
var)
                    (\() -> Fay ()
unsubscribe Bool
lockedNow ->
                       if Bool
lockedNow
                          then () -> Fay ()
forall a. a -> Fay a
return ()
                          else do () -> Fay ()
unsubscribe ()
                                  Fay ()
cont)
             () -> Fay ()
forall a. a -> Fay a
return ()

     else Fay ()
cont

-- | Lock the given mutex until I'm done with it.
lockMutex :: Mutex -> (Fay () -> Fay a) -> Fay a
lockMutex :: Mutex -> (Fay () -> Fay a) -> Fay a
lockMutex (Mutex Ptr (Var Bool)
var) Fay () -> Fay a
cont = do
  Bool
locked <- Ptr (Var Bool) -> Fay Bool
forall (v :: * -> *) a. Gettable (v a) => v a -> Fay a
get Ptr (Var Bool)
var
  if Bool
locked
     then String -> Fay a
forall a. String -> a
error String
"mutex is already locked"
     else do Ptr (Var Bool) -> Bool -> Fay ()
forall (v :: * -> *) a. Settable (v a) => v a -> a -> Fay ()
set Ptr (Var Bool)
var Bool
True
             Fay () -> Fay a
cont (Ptr (Var Bool) -> Bool -> Fay ()
forall (v :: * -> *) a. Settable (v a) => v a -> a -> Fay ()
set Ptr (Var Bool)
var Bool
False)