{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
module Data.Var
(
Sig
, newSig
, Ref
, newRef
, Var
, newVar
, Settable
, set
, Gettable
, get
, modify
, modifyWith
, Subscribable
, subscribe
, withUnsubscriber
, subscribeWithOld
, subscribeChange
, subscribeAndRead
, subscribeChangeAndRead
, subscribeExclusive
, subscribeAndReadExclusive
, mapVar
, mergeVars
, mergeVars'
, tupleVars
, tupleVars'
, waitForN
, waitFor
, oneShot
, holdSig
) where
import Data.Maybe
import FFI
import Prelude
data Sig a
newSig :: Fay (Ptr (Sig a))
newSig = ffi "new Fay$$Sig()"
data Ref a
newRef :: Ptr a -> Fay (Ptr (Ref a))
newRef = ffi "new Fay$$Ref2(%1)"
data Var a
newVar :: Ptr a -> Fay (Ptr (Var a))
newVar = ffi "new Fay$$Var(%1)"
class Settable v
instance Settable (Ref a)
instance Settable (Sig a)
instance Settable (Var a)
set :: Settable (v a) => Ptr (v a) -> Ptr a -> Fay ()
set = ffi "Fay$$setValue(Fay$$_(%1), %2, Fay$$_)"
class Gettable v
instance Gettable (Ref a)
instance Gettable (Var a)
get :: Gettable (v a) => Ptr (v a) -> Fay (Ptr a)
get = ffi "Fay$$_(%1).val"
modify :: (Settable (v a), Gettable (v a)) => v a -> (a -> a) -> Fay ()
modify v f = get v >>= set v . f
modifyWith :: (Settable (v a), Gettable (v a)) => v a -> (a -> Fay a) -> Fay ()
modifyWith v f = get v >>= f >>= set v
class Settable v => Subscribable v
instance Subscribable (Sig a)
instance Subscribable (Var a)
subscribe :: Subscribable (v a) => Ptr (v a) -> Ptr (a -> Fay void) -> Fay (() -> Fay ())
subscribe = ffi "Fay$$subscribe(Fay$$_(%1), Fay$$_(%2))"
withUnsubscriber :: ((a -> Fay ()) -> Fay (() -> Fay ()))
-> (((() -> Fay ()) -> a -> Fay ()) -> Fay (() -> Fay ()))
withUnsubscriber f = \g -> do
unsubscriber <- newRef Nothing
unsubscribe <- f $ \v -> do munsubscriber <- get unsubscriber
whenJust munsubscriber $ \unsubscribe -> g unsubscribe v
set unsubscriber (Just unsubscribe)
return unsubscribe
subscribeWithOld :: Var a -> (a -> a -> Fay ()) -> Fay (() -> Fay ())
subscribeWithOld v f = do
o <- get v >>= newRef
subscribe v $ \x' -> do
x <- get o
set o x'
f x x'
subscribeChange :: Eq a => Var a -> (a -> Fay ()) -> Fay (() -> Fay ())
subscribeChange v f = subscribeWithOld v $ \x x' -> when (x /= x') $ f x'
subscribeAndRead :: Var a -> (a -> Fay void) -> Fay (() -> Fay ())
subscribeAndRead v f = do
x <- get v
_ <- f x
subscribe v f
subscribeChangeAndRead :: Eq a => Var a -> (a -> Fay ()) -> Fay (() -> Fay ())
subscribeChangeAndRead v f = do
x <- get v
f x
subscribeChange v f
subscribeExclusive :: Subscribable (v a) => v a -> (a -> Fay ()) -> Fay (a -> Fay (), () -> Fay ())
subscribeExclusive v onChange = do
bracket <- getBracket
unsubscribe <- subscribe v $ bracket . onChange
return (\x -> bracket $ set v x, unsubscribe)
subscribeAndReadExclusive :: Var a -> (a -> Fay ()) -> Fay (a -> Fay (), () -> Fay ())
subscribeAndReadExclusive v onChange = do
bracket <- getBracket
unsubscribe <- subscribeAndRead v $ bracket . onChange
return (\x -> bracket $ set v x, unsubscribe)
getBracket :: Fay (Fay () -> Fay ())
getBracket = do
rhandle <- newRef True
return $ \f -> do
handle <- get rhandle
when handle $ do
set rhandle False
f
set rhandle True
mapVar :: (a -> b) -> Var a -> Fay (Var b)
mapVar f v = do
x <- get v
r <- newVar (f x)
_ <- subscribe v $ \x' -> set r $ f x'
return r
mergeVars :: (a -> b -> c) -> Maybe (c -> (a, b)) -> Var a -> Var b
-> Fay (Var c, Fay ())
mergeVars f mg va vb = do
bracket <- getBracket
a0 <- get va
b0 <- get vb
vc <- newVar (f a0 b0)
unsubscribeA <- subscribe va $ \a -> bracket $ do
b <- get vb
set vc (f a b)
unsubscribeB <- subscribe vb $ \b -> bracket $ do
a <- get va
set vc (f a b)
unsubscribe <- case mg of
Nothing -> return $ unsubscribeA () >> unsubscribeB ()
Just g -> do
unsubscribeC <- subscribe vc $ \c -> bracket $ case g c of
(a, b) -> do
setInternal va a
setInternal vb b
broadcastInternal va a
broadcastInternal vb b
return $ unsubscribeA () >> unsubscribeB () >> unsubscribeC ()
return (vc, unsubscribe)
setInternal :: Ptr (Var a) -> Ptr a -> Fay ()
setInternal = ffi "function() { Fay$$_(%1).val = %2; }()"
broadcastInternal :: Ptr (Var a) -> Ptr a -> Fay ()
broadcastInternal = ffi "Fay$$broadcastInternal(Fay$$_(%1), %2, Fay$$_)"
mergeVars' :: (a -> b -> c) -> Maybe (c -> (a, b)) -> Var a -> Var b
-> Fay (Var c)
mergeVars' f mg va vb = do
result <- mergeVars f mg va vb
case result of
(v, _) -> return v
tupleVars :: Var a -> Var b -> Fay (Var (a, b), Fay ())
tupleVars = mergeVars (\x y -> (x, y)) (Just id)
tupleVars' :: Var a -> Var b -> Fay (Var (a, b))
tupleVars' va vb = do
result <- tupleVars va vb
case result of
(v, _) -> return v
waitForN :: Int -> Fay (Fay void -> Fay (),Sig ())
waitForN n = do
sig <- newSig
count <- newVar (0 :: Int)
_ <- subscribe sig (const (modify count (+1)))
return (\m -> subscribeAndRead count (\i -> when (i == n) (m >> return ())) >> return (),sig)
waitFor :: Var a -> (a -> Bool) -> (a -> Fay ()) -> Fay ()
waitFor v p f = do
_ <- withUnsubscriber (subscribeAndRead v)
$ \unsubscribe x -> when (p x) $ unsubscribe () >> f x
return ()
oneShot :: Subscribable (v a) => v a -> (a -> Fay ()) -> Fay ()
oneShot v f = do
_ <- withUnsubscriber (subscribe v) $ \unsubscribe x -> unsubscribe () >> f x
return ()
holdSig :: a -> Sig a -> Fay (Var a)
holdSig initial sig = do
v <- newVar initial
void $ subscribe sig $ set v
return v