fay-base-0.20.0.1: src/Data/Var.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}

module Data.Var
  (
  -- * Different types of variables
    Sig
  , newSig
  , Ref
  , newRef
  , Var
  , newVar

  -- * Generic operations
  , Settable
  , set
  , Gettable
  , get
  , modify
  , modifyWith
  , Subscribable
  , subscribe
  , withUnsubscriber

  -- * Specific operations
  , subscribeWithOld
  , subscribeChange
  , subscribeAndRead
  , subscribeChangeAndRead
  , subscribeExclusive
  , subscribeAndReadExclusive
  , mapVar
  , mergeVars
  , mergeVars'
  , tupleVars
  , tupleVars'
  , waitForN
  , waitFor
  , oneShot
  , holdSig

  ) where

import Data.Maybe
import FFI
import Prelude

-- | A subscribable signal.  Can have handlers subscribed to them, but doesn't
--   store a value.
data Sig a

-- | Make a new signal.
newSig :: Fay (Ptr (Sig a))
newSig = ffi "new Fay$$Sig()"

-- | A mutable reference, with no subscribers.
data Ref a

-- | Make a new mutable reference.
newRef :: Ptr a -> Fay (Ptr (Ref a))
newRef = ffi "new Fay$$Ref2(%1)"

-- | A reactive variable.  Stores a value, and can have handlers subscribed to
--   changes.
data Var a

-- | Make a new reactive variable.
newVar :: Ptr a -> Fay (Ptr (Var a))
newVar = ffi "new Fay$$Var(%1)"


-- | All of the variable types can be set to a value.
class Settable v
instance Settable (Ref a)
instance Settable (Sig a)
instance Settable (Var a)

-- | Write to the value (if any), and call subscribers (if any).
set :: Settable (v a) => Ptr (v a) -> Ptr a -> Fay ()
set = ffi "Fay$$setValue(Fay$$_(%1), %2, Fay$$_)"


-- | 'Ref' and 'Var' store their last set value.
class Gettable v
instance Gettable (Ref a)
instance Gettable (Var a)

-- | Get the value of a 'Ref' or 'Var'.
get :: Gettable (v a) => Ptr (v a) -> Fay (Ptr a)
get = ffi "Fay$$_(%1).val"

-- | Modifies the current value with a pure function.
modify :: (Settable (v a), Gettable (v a)) => v a -> (a -> a) -> Fay ()
modify v f = get v >>= set v . f

-- | Runs a 'Fay' action on the current value, and updates with the result.
modifyWith :: (Settable (v a), Gettable (v a)) => v a -> (a -> Fay a) -> Fay ()
modifyWith v f = get v >>= f >>= set v

-- | 'Sig' and 'Var' have lists of subscribers that are notified when 'set' is
--   used.
class Settable v => Subscribable v
instance Subscribable (Sig a)
instance Subscribable (Var a)

-- | Subscribe to the value of a 'Sig' or 'Var'.
--
--   The result is an unsubscribe function.
subscribe :: Subscribable (v a) => Ptr (v a) -> Ptr (a -> Fay void) -> Fay (() -> Fay ())
subscribe = ffi "Fay$$subscribe(Fay$$_(%1), Fay$$_(%2))"

-- | Run the same subscribing action but provide an additional
-- unsubscribe parameter to the handler.
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

-- | Subscribe to a 'Var', along with the previous value.
--
--   The result is an unsubscribe function.
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'

-- | Subscribe to a 'Var', but only call handler when it actually changes.
--
--   The result is an unsubscribe function.
subscribeChange :: Eq a => Var a -> (a -> Fay ()) -> Fay (() -> Fay ())
subscribeChange v f = subscribeWithOld v $ \x x' -> when (x /= x') $ f x'

-- | Subscribe to a 'Var', and call the function on the current value.
--
--   The result is an unsubscribe function.
subscribeAndRead :: Var a -> (a -> Fay void) -> Fay (() -> Fay ())
subscribeAndRead v f = do
  x <- get v
  f x
  subscribe v f

-- | Subscribe to a 'Var', but only call handler when it actually changes, and
--   also initially on registration.
--
--   The result is an unsubscribe function.
subscribeChangeAndRead :: Eq a => Var a -> (a -> Fay ()) -> Fay (() -> Fay ())
subscribeChangeAndRead v f = do
  x <- get v
  f x
  subscribeChange v f


-- | Given a change handler, returns a function that can be used to set a
--   subscribable without invoking the handler.  This can be useful in
--   situations where the handler for a 'Var' causes an event which otherwise
--   ought to set the value of the 'Var'.  An example of this is interfacing
--   with HTML input field change events.
--
--   The 'snd' part of the result is an unsubscribe function.
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)

-- | Given a change handler, returns a function that can be used to set a var
--   without invoking the handler. The handler is called with the initial
--   value. This can be useful in situations where the handler for a 'Var'
--   causes an event which otherwise ought to set the value of the 'Var'.  An
--   example of this is interfacing with HTML input field change events.
--
--   The 'snd' part of the result is an unsubscribe function.
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)

-- Utility used for 'subscribeExclusive', 'subscribeAndReadExclusive', and
-- 'mergeVars'.
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

--TODO: mapVar variant that's bidirectional?
--TODO: return unsubscribe?

-- | Creates a 'Var' that updates whenever the source var is changed, applying
--   the provided function to compute the new value.
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

-- | Creates a 'Var' that updates whenever one of its source vars are changed.
--   If the 2nd argument is a 'Just' value, then its used to set the source
--   vars when the variable is changed. Setting using a merged var is
--   sometimes preferred because both values are set before the subscribers
--   are called.
--
--   The 'snd' part of the result is an unsubscribe function.
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
          -- Set variables before broadcast.
          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$$_)"

-- | Like 'mergeVars', but discards the unsubscribe function.
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

-- | Creates a 'Var' that updates whenever one of its source vars are changed.
--   It can also be used to set both source vars at once.
--
--   See 'mergeVars' for more information.  Note that when using nested tuples,
--   if you want all of the values to be set before broadcast, then they should
--   nest to the left.
tupleVars :: Var a -> Var b -> Fay (Var (a, b), Fay ())
tupleVars = mergeVars (\x y -> (x, y)) (Just id)

-- | Like 'tupleVars', but discards the unsubscribe function.
tupleVars' :: Var a -> Var b -> Fay (Var (a, b))
tupleVars' va vb = do
  result <- tupleVars va vb
  case result of
    (v, _) -> return v

-- | Wait for n signals on the given signaller.
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)

-- | Wait for the given predicate to be satisfied on the var and then
-- unsubscribe.
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 ()

-- | Make a one-shot variable subscription that immediately
-- unsubscribes after the event has triggered.
oneShot :: Subscribable (v a) => v a -> (a -> Fay ()) -> Fay ()
oneShot v f = do
  _ <- withUnsubscriber (subscribe v) $ \unsubscribe x -> unsubscribe () >> f x
  return ()

-- | Turn a sig into a var, by storing the last reported value.
holdSig :: a -> Sig a -> Fay (Var a)
holdSig initial sig = do
  v <- newVar initial
  void $ subscribe sig $ set v
  return v