module Data.AVar.Internal (
AVar(..),
Transaction(..),
newAVar
) where
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Concurrent.Chan
import qualified Control.Exception as E
data Transaction a =
Put a
| Get (MVar a)
| Mod (a -> a) (MVar (Maybe E.SomeException))
| JustMod (a -> a)
| forall b. Mod' (a -> (a,b)) (MVar (Either E.SomeException b))
| Atom (a -> Bool) (a -> a) (a -> a) (MVar (Either E.SomeException Bool))
data AVar a = AVar (Chan (Transaction a))
newAVar :: a -> IO (AVar a)
newAVar x = do
E.evaluate x
chan <- newChan :: IO (Chan (Transaction a))
forkIO (handler chan x)
return (AVar chan)
handler :: Chan (Transaction a) -> a -> IO b
handler chan !x = do
req <- readChan chan
case req of
Put a -> handler chan a
Get mvar -> do
putMVar mvar x
handler chan x
Mod f mvar -> do
let x' = f x
p <- E.catch (E.evaluate x' >> return Nothing)
(\e -> return (Just e))
putMVar mvar p
case p of
Nothing -> handler chan x'
_ -> handler chan x
JustMod f -> do
let x' = f x
res <- E.try (E.evaluate x')
case res of
Right _ -> handler chan x'
Left (_::E.SomeException) -> handler chan x
Mod' f mvar -> do
let y@(a,b) = f x
p <- E.try (E.evaluate a >> E.evaluate b)
case p of
Right _ -> do
putMVar mvar (Right b)
handler chan a
(Left e) -> do
putMVar mvar (Left e)
handler chan x
Atom test y n res -> do
let t' = test x
y' = y x
n' = n x
tres <- E.try (E.evaluate t')
case tres of
rT@(Right True) -> do
run <- E.try (E.evaluate y')
case run of
Right x' -> putMVar res rT >> handler chan x'
Left e -> putMVar res (Left e) >> handler chan x
rF@(Right False) -> do
run <- E.try (E.evaluate n')
case run of
Right x' -> putMVar res rF >> handler chan x'
Left e -> putMVar res (Left e) >> handler chan x
Left e -> putMVar res (Left e) >> handler chan x