{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BlockArguments #-}
{- |
Module: Control.Concurrent.STM.Incremental
Description: A set of combinators for constructing and observing incremental computations.
Copyright: (c) Samuel Schlesinger 2020
License: MIT
Maintainer: sgschlesinger@gmail.com
Stability: experimental
Portability: POSIX, Windows

This library exposes a minimal interface for incremental computation,
where we decompose our computation into the explicit computational dependencies
and only recompute things when their dependencies have been recomputed. Here is
a basic example:

@
main = do
  (a, b, c, d) <- atomically $ do
    a <- incremental 0
    b <- incremental 1
    c <- imap (+ 1) b
    d <- combine (+) c b
    pure (a, b, c, d)

  guard =<< (atomically $ do
    (== 3) <$> observe d)

  guard =<< (atomically $ do
    set a 1
    set b 0
    (== 1) <$> observe d)
@

Here, we see that we can set some variables and notice their changes, all done
in 'STM' 'atomically' blocks which allows us to combine these computations
transactionally with other logic we've written in 'STM'. What happens if we try
to write to @c@? Well, we get a type error! The only 'Incremental' computations
which we can set new values for are the leaves of the computation, constructed
with 'incremental'. This is this way because we don't want to mutate 'Incremental's
downstream of dependencies, because then we cannot know that those computations
remain consistent. Most operations are polymorphic over 'Mutable' and 'Immutable'
'Incremental's, but 'imap', 'combine', and 'choose' all produce an @'Incremental' 'Immutable'@,
whereas 'incremental' produces a @'Incremental' 'Mutable'@.

-}
module Control.Concurrent.STM.Incremental
( Mutability(Immutable, Mutable)
, Incremental
, incremental
, observe
, set
, setEq
, imap
, imapEq
, combine
, combineEq
, choose
, chooseEq
, immutable
, onUpdate
, history
) where

import Prelude

import Control.Concurrent.STM
import Control.Monad (when)

-- Internal Documentation
--
-- An 'Incremental' consists of a 'ref', a 'TVar' which always
-- holds an up to date value that this 'Incremental' is currently equal to,
-- and an 'updateRef', a 'TVar' which always holds the code we need to run
-- upon updating this 'Incremental'. When we make an 'Incremental' using
-- 'incremental', we simply write the value in and do nothing upon update,
-- because no other 'Incremental' depends on us yet. When we make an
-- 'Incremental' using 'map', 'combine', or 'choose', we make sure to
-- modify the input 'Incremental's' 'updateRef's, as we need to update this
-- new dependent whenever we update its dependencies. Whenever we update an
-- 'Incremental' for one of these purposes, we must recursively run the
-- update code in its 'updateRef'. This allows the variables to propagate
-- outwards and allow us to observe results of the rectified computation.
--
-- We offer functions with 'Eq' suffixes which have the added optimization
-- that if the new value for an 'Incremental' is equal, we don't propagate
-- updates to its dependents. This can be used very profitably in
-- computations with subcomputations which have much smaller images than
-- domains, which often is the case.

-- | A data kind intended to help us expose a safe interface, only allowing
-- us to modify leaf nodes of computational graphs as to avoid inconsistent states.
data Mutability = Immutable | Mutable

-- | An incremental computation, only updated when one of its dependencies
-- is.
data Incremental (mutability :: Mutability) a = Incremental
  { forall (mutability :: Mutability) a.
Incremental mutability a -> TVar a
ref :: TVar a
  , forall (mutability :: Mutability) a.
Incremental mutability a -> TVar (a -> STM ())
updateRef :: TVar (a -> STM ())
  }

-- | Construct a trivial, mutable incremental computation. This is mutable
-- precisely because it is trivial, as modifications to anything else
-- cannot cause it to be modified. Thus, we can change it willy nilly
-- without fear that we've invalidated someone else's changes to it.
incremental
  :: a
  -> STM (Incremental 'Mutable a)
incremental :: forall a. a -> STM (Incremental 'Mutable a)
incremental a
a = do
  TVar a
ref <- forall a. a -> STM (TVar a)
newTVar a
a
  forall (mutability :: Mutability) a.
TVar a -> TVar (a -> STM ()) -> Incremental mutability a
Incremental TVar a
ref forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> STM (TVar a)
newTVar (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))

-- | Create an incrementally mapped computation, producing an immutable
-- incremental computation that will always contain the function mapped
-- over the value inside of the original computation.
imap
  :: (a -> b) 
  -> Incremental m a
  -> STM (Incremental 'Immutable b)
imap :: forall a b (m :: Mutability).
(a -> b) -> Incremental m a -> STM (Incremental 'Immutable b)
imap a -> b
f (Incremental TVar a
ref TVar (a -> STM ())
updateRef) = do
  TVar b
newRef <- forall a. TVar a -> STM a
readTVar TVar a
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> STM (TVar a)
newTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  TVar (b -> STM ())
newUpdateRef <- forall a. a -> STM (TVar a)
newTVar (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
  a -> STM ()
update <- forall a. TVar a -> STM a
readTVar TVar (a -> STM ())
updateRef
  forall a. TVar a -> a -> STM ()
writeTVar TVar (a -> STM ())
updateRef \a
a -> do
    a -> STM ()
update a
a
    let b :: b
b = a -> b
f a
a
    forall a. TVar a -> a -> STM ()
writeTVar TVar b
newRef b
b
    b -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
newUpdateRef
    b -> STM ()
newUpdate b
b
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (mutability :: Mutability) a.
TVar a -> TVar (a -> STM ()) -> Incremental mutability a
Incremental TVar b
newRef TVar (b -> STM ())
newUpdateRef)

-- | Create an incrementally mapped computation, producing an immutable
-- incremental computation that will always contain the function mapped
-- over the value inside of the original computation.
imapEq
  :: Eq b
  => (a -> b)
  -> Incremental m a
  -> STM (Incremental 'Immutable b)
imapEq :: forall b a (m :: Mutability).
Eq b =>
(a -> b) -> Incremental m a -> STM (Incremental 'Immutable b)
imapEq a -> b
f (Incremental TVar a
ref TVar (a -> STM ())
updateRef) = do
  TVar b
newRef <- forall a. TVar a -> STM a
readTVar TVar a
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> STM (TVar a)
newTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  TVar (b -> STM ())
newUpdateRef <- forall a. a -> STM (TVar a)
newTVar (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
  a -> STM ()
update <- forall a. TVar a -> STM a
readTVar TVar (a -> STM ())
updateRef
  forall a. TVar a -> a -> STM ()
writeTVar TVar (a -> STM ())
updateRef \a
a -> do
    a -> STM ()
update a
a
    b
b <- forall a. TVar a -> STM a
readTVar TVar b
newRef
    let b' :: b
b' = a -> b
f a
a
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (b
b forall a. Eq a => a -> a -> Bool
/= b
b') do
      forall a. TVar a -> a -> STM ()
writeTVar TVar b
newRef b
b'
      b -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
newUpdateRef
      b -> STM ()
newUpdate b
b'
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (mutability :: Mutability) a.
TVar a -> TVar (a -> STM ()) -> Incremental mutability a
Incremental TVar b
newRef TVar (b -> STM ())
newUpdateRef)

-- | Sets the value of a mutable incremental computation.
set
  :: Incremental 'Mutable a
  -> a
  -> STM ()
set :: forall a. Incremental 'Mutable a -> a -> STM ()
set Incremental 'Mutable a
incr a
a = do
  forall a. TVar a -> a -> STM ()
writeTVar (forall (mutability :: Mutability) a.
Incremental mutability a -> TVar a
ref Incremental 'Mutable a
incr) a
a
  a -> STM ()
update <- forall a. TVar a -> STM a
readTVar (forall (mutability :: Mutability) a.
Incremental mutability a -> TVar (a -> STM ())
updateRef Incremental 'Mutable a
incr)
  a -> STM ()
update a
a

-- | Sets the value of a mutable incremental computation, with the added
-- optimization that if the value is equal to the old one, this does not
-- update the dependents of this 'Incremental' value.
setEq
  :: Eq a
  => Incremental 'Mutable a
  -> a
  -> STM ()
setEq :: forall a. Eq a => Incremental 'Mutable a -> a -> STM ()
setEq Incremental 'Mutable a
incr a
a = do
  a
a' <- forall a. TVar a -> STM a
readTVar (forall (mutability :: Mutability) a.
Incremental mutability a -> TVar a
ref Incremental 'Mutable a
incr)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
a' forall a. Eq a => a -> a -> Bool
/= a
a) do
    forall a. TVar a -> a -> STM ()
writeTVar (forall (mutability :: Mutability) a.
Incremental mutability a -> TVar a
ref Incremental 'Mutable a
incr) a
a
    a -> STM ()
update <- forall a. TVar a -> STM a
readTVar (forall (mutability :: Mutability) a.
Incremental mutability a -> TVar (a -> STM ())
updateRef Incremental 'Mutable a
incr)
    a -> STM ()
update a
a

-- | Observes the present value of any incremental computation.
observe
  :: Incremental m a
  -> STM a
observe :: forall (m :: Mutability) a. Incremental m a -> STM a
observe = forall a. TVar a -> STM a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (mutability :: Mutability) a.
Incremental mutability a -> TVar a
ref

-- | Combines the results of two incremental computation into a third,
-- producing an immutable incremental computation that will always contain
-- the function mapped over both of the values inside of the respective
-- incremental computations.
combine
  :: (a -> b -> c)
  -> Incremental m a
  -> Incremental m' b
  -> STM (Incremental 'Immutable c)
combine :: forall a b c (m :: Mutability) (m' :: Mutability).
(a -> b -> c)
-> Incremental m a
-> Incremental m' b
-> STM (Incremental 'Immutable c)
combine a -> b -> c
f (Incremental TVar a
ref TVar (a -> STM ())
updateRef) (Incremental TVar b
ref' TVar (b -> STM ())
updateRef') = do
  a
a <- forall a. TVar a -> STM a
readTVar TVar a
ref
  b
b <- forall a. TVar a -> STM a
readTVar TVar b
ref'
  TVar c
newRef <- forall a. a -> STM (TVar a)
newTVar (a -> b -> c
f a
a b
b)
  TVar (c -> STM ())
newUpdateRef <- forall a. a -> STM (TVar a)
newTVar (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
  a -> STM ()
update <- forall a. TVar a -> STM a
readTVar TVar (a -> STM ())
updateRef
  b -> STM ()
update' <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
updateRef'
  forall a. TVar a -> a -> STM ()
writeTVar TVar (a -> STM ())
updateRef \a
a -> do
    a -> STM ()
update a
a
    b
b <- forall a. TVar a -> STM a
readTVar TVar b
ref'
    let c :: c
c = a -> b -> c
f a
a b
b
    forall a. TVar a -> a -> STM ()
writeTVar TVar c
newRef c
c
    c -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (c -> STM ())
newUpdateRef
    c -> STM ()
newUpdate c
c
  forall a. TVar a -> a -> STM ()
writeTVar TVar (b -> STM ())
updateRef' \b
b -> do
    b -> STM ()
update' b
b
    a
a <- forall a. TVar a -> STM a
readTVar TVar a
ref
    let c :: c
c = a -> b -> c
f a
a b
b
    forall a. TVar a -> a -> STM ()
writeTVar TVar c
newRef c
c
    c -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (c -> STM ())
newUpdateRef
    c -> STM ()
newUpdate c
c
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (mutability :: Mutability) a.
TVar a -> TVar (a -> STM ()) -> Incremental mutability a
Incremental TVar c
newRef TVar (c -> STM ())
newUpdateRef)

-- | Like 'combine', but with the added optimization that if the value
-- computed is equal to the old one, it will not propagate the update
-- through any further.
combineEq
  :: Eq c
  => (a -> b -> c)
  -> Incremental m a
  -> Incremental m' b
  -> STM (Incremental 'Immutable c)
combineEq :: forall c a b (m :: Mutability) (m' :: Mutability).
Eq c =>
(a -> b -> c)
-> Incremental m a
-> Incremental m' b
-> STM (Incremental 'Immutable c)
combineEq a -> b -> c
f (Incremental TVar a
ref TVar (a -> STM ())
updateRef) (Incremental TVar b
ref' TVar (b -> STM ())
updateRef') = do
  a
a <- forall a. TVar a -> STM a
readTVar TVar a
ref
  b
b <- forall a. TVar a -> STM a
readTVar TVar b
ref'
  TVar c
newRef <- forall a. a -> STM (TVar a)
newTVar (a -> b -> c
f a
a b
b)
  TVar (c -> STM ())
newUpdateRef <- forall a. a -> STM (TVar a)
newTVar (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
  a -> STM ()
update <- forall a. TVar a -> STM a
readTVar TVar (a -> STM ())
updateRef
  b -> STM ()
update' <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
updateRef'
  forall a. TVar a -> a -> STM ()
writeTVar TVar (a -> STM ())
updateRef \a
a -> do
    a -> STM ()
update a
a
    b
b <- forall a. TVar a -> STM a
readTVar TVar b
ref'
    c
c <- forall a. TVar a -> STM a
readTVar TVar c
newRef
    let c' :: c
c' = a -> b -> c
f a
a b
b
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (c
c forall a. Eq a => a -> a -> Bool
/= c
c') do
      forall a. TVar a -> a -> STM ()
writeTVar TVar c
newRef c
c'
      c -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (c -> STM ())
newUpdateRef
      c -> STM ()
newUpdate c
c'
  forall a. TVar a -> a -> STM ()
writeTVar TVar (b -> STM ())
updateRef' \b
b -> do
    b -> STM ()
update' b
b
    a
a <- forall a. TVar a -> STM a
readTVar TVar a
ref
    c
c <- forall a. TVar a -> STM a
readTVar TVar c
newRef
    let c' :: c
c' = a -> b -> c
f a
a b
b
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (c
c forall a. Eq a => a -> a -> Bool
/= c
c') do
      forall a. TVar a -> a -> STM ()
writeTVar TVar c
newRef c
c'
      c -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (c -> STM ())
newUpdateRef
      c -> STM ()
newUpdate c
c'
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (mutability :: Mutability) a.
TVar a -> TVar (a -> STM ()) -> Incremental mutability a
Incremental TVar c
newRef TVar (c -> STM ())
newUpdateRef)

-- | Sometimes, we need to consider an @'Incremental' 'Mutable'@ in
-- a setting alongside @'Incremental' 'Immutable'@ values, unifying their
-- type. One example where this is common is in 'choose':
--
-- @
-- ...
-- x <- incremental True
-- y <- map not x
-- z <- choose y (bool y x)
-- ...
-- @
--
-- This code will not compile, because @y@ and @x@ have different types, but this will:
--
-- @
-- ...
-- x <- incremental True
-- y <- map not x
-- z <- choose y (bool y (immutable x))
-- ...
-- @
immutable
  :: Incremental 'Mutable b
  -> Incremental 'Immutable b
immutable :: forall b. Incremental 'Mutable b -> Incremental 'Immutable b
immutable Incremental{TVar b
TVar (b -> STM ())
updateRef :: TVar (b -> STM ())
ref :: TVar b
updateRef :: forall (mutability :: Mutability) a.
Incremental mutability a -> TVar (a -> STM ())
ref :: forall (mutability :: Mutability) a.
Incremental mutability a -> TVar a
..} = Incremental{TVar b
TVar (b -> STM ())
updateRef :: TVar (b -> STM ())
ref :: TVar b
updateRef :: TVar (b -> STM ())
ref :: TVar b
..}

-- | Chooses an incremental computation depending on the value inside of another
-- one. When using 'map' and 'combine', you are constructing
-- a static dependency graph, whereas when you use this function you are
-- making it dynamic, the linkages depending on the actual contents of the
-- incremental computation nodes.
choose
  :: Incremental m' a
  -> (a -> Incremental m b)
  -> STM (Incremental 'Immutable b)
choose :: forall (m' :: Mutability) a (m :: Mutability) b.
Incremental m' a
-> (a -> Incremental m b) -> STM (Incremental 'Immutable b)
choose (Incremental TVar a
ref TVar (a -> STM ())
updateRef) a -> Incremental m b
f = do
  a
a <- forall a. TVar a -> STM a
readTVar TVar a
ref
  let Incremental TVar b
ref' TVar (b -> STM ())
updateRef' = a -> Incremental m b
f a
a
  TVar b
newRef <- forall a. TVar a -> STM a
readTVar TVar b
ref' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> STM (TVar a)
newTVar
  TVar (b -> STM ())
newUpdateRef <- forall a. a -> STM (TVar a)
newTVar (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
  b -> STM ()
update' <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
updateRef'
  a -> STM ()
update <- forall a. TVar a -> STM a
readTVar TVar (a -> STM ())
updateRef
  TVar (TVar b, [TVar b])
updateFromWhichRef <- forall a. a -> STM (TVar a)
newTVar (TVar b
ref', [TVar b
ref'])
  forall a. TVar a -> a -> STM ()
writeTVar TVar (b -> STM ())
updateRef' \b
b -> do
    b -> STM ()
update' b
b
    (TVar b
tvar, [TVar b]
_tvars) <- forall a. TVar a -> STM a
readTVar TVar (TVar b, [TVar b])
updateFromWhichRef
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TVar b
tvar forall a. Eq a => a -> a -> Bool
== TVar b
ref') do
      forall a. TVar a -> a -> STM ()
writeTVar TVar b
newRef b
b
      b -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
newUpdateRef
      b -> STM ()
newUpdate b
b
  forall a. TVar a -> a -> STM ()
writeTVar TVar (a -> STM ())
updateRef \a
a -> do
    a -> STM ()
update a
a
    (TVar b
currentRef, [TVar b]
pastRefs) <- forall a. TVar a -> STM a
readTVar TVar (TVar b, [TVar b])
updateFromWhichRef
    let Incremental TVar b
ref'' TVar (b -> STM ())
updateRef'' = a -> Incremental m b
f a
a
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TVar b
ref'' forall a. Eq a => a -> a -> Bool
/= TVar b
currentRef) do
      b
b <- forall a. TVar a -> STM a
readTVar TVar b
ref''
      forall a. TVar a -> a -> STM ()
writeTVar TVar b
newRef b
b
      b -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
newUpdateRef
      b -> STM ()
newUpdate b
b
      if Bool -> Bool
not (TVar b
ref'' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TVar b]
pastRefs) then do
        b -> STM ()
update'' <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
updateRef''
        forall a. TVar a -> a -> STM ()
writeTVar TVar (b -> STM ())
updateRef'' \b
b -> do
          b -> STM ()
update'' b
b
          (TVar b
tvar, [TVar b]
_tvars) <- forall a. TVar a -> STM a
readTVar TVar (TVar b, [TVar b])
updateFromWhichRef
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TVar b
tvar forall a. Eq a => a -> a -> Bool
== TVar b
ref'') do
            forall a. TVar a -> a -> STM ()
writeTVar TVar b
newRef b
b
            b -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
newUpdateRef
            b -> STM ()
newUpdate b
b
        forall a. TVar a -> a -> STM ()
writeTVar TVar (TVar b, [TVar b])
updateFromWhichRef (TVar b
ref'', TVar b
ref'' forall a. a -> [a] -> [a]
: [TVar b]
pastRefs)
      else forall a. TVar a -> a -> STM ()
writeTVar TVar (TVar b, [TVar b])
updateFromWhichRef (TVar b
ref'', [TVar b]
pastRefs)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (mutability :: Mutability) a.
TVar a -> TVar (a -> STM ()) -> Incremental mutability a
Incremental TVar b
newRef TVar (b -> STM ())
newUpdateRef)

-- | Like 'choose', but with the added optimization that we do not
-- propagate changes when we don't have to in a similar way to 'setEq',
-- 'combineEq', and 'imapEq'.
chooseEq :: Eq b
  => Incremental m' a
  -> (a -> Incremental m b)
  -> STM (Incremental 'Immutable b)
chooseEq :: forall b (m' :: Mutability) a (m :: Mutability).
Eq b =>
Incremental m' a
-> (a -> Incremental m b) -> STM (Incremental 'Immutable b)
chooseEq (Incremental TVar a
ref TVar (a -> STM ())
updateRef) a -> Incremental m b
f = do
  a
a <- forall a. TVar a -> STM a
readTVar TVar a
ref
  let Incremental TVar b
ref' TVar (b -> STM ())
updateRef' = a -> Incremental m b
f a
a
  TVar b
newRef <- forall a. TVar a -> STM a
readTVar TVar b
ref' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> STM (TVar a)
newTVar
  TVar (b -> STM ())
newUpdateRef <- forall a. a -> STM (TVar a)
newTVar (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
  b -> STM ()
update' <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
updateRef'
  a -> STM ()
update <- forall a. TVar a -> STM a
readTVar TVar (a -> STM ())
updateRef
  TVar (TVar b, [TVar b])
updateFromWhichRef <- forall a. a -> STM (TVar a)
newTVar (TVar b
ref', [TVar b
ref'])
  forall a. TVar a -> a -> STM ()
writeTVar TVar (b -> STM ())
updateRef' \b
b -> do
    b -> STM ()
update' b
b
    (TVar b
tvar, [TVar b]
_tvars) <- forall a. TVar a -> STM a
readTVar TVar (TVar b, [TVar b])
updateFromWhichRef
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TVar b
tvar forall a. Eq a => a -> a -> Bool
== TVar b
ref') do
      b
b' <- forall a. TVar a -> STM a
readTVar TVar b
newRef
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (b
b' forall a. Eq a => a -> a -> Bool
/= b
b) do
        forall a. TVar a -> a -> STM ()
writeTVar TVar b
newRef b
b
        b -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
newUpdateRef
        b -> STM ()
newUpdate b
b
  forall a. TVar a -> a -> STM ()
writeTVar TVar (a -> STM ())
updateRef \a
a -> do
    a -> STM ()
update a
a
    (TVar b
currentRef, [TVar b]
pastRefs) <- forall a. TVar a -> STM a
readTVar TVar (TVar b, [TVar b])
updateFromWhichRef
    let Incremental TVar b
ref'' TVar (b -> STM ())
updateRef'' = a -> Incremental m b
f a
a
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TVar b
ref'' forall a. Eq a => a -> a -> Bool
/= TVar b
currentRef) do
      b
b <- forall a. TVar a -> STM a
readTVar TVar b
ref''
      forall a. TVar a -> a -> STM ()
writeTVar TVar b
newRef b
b
      b -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
newUpdateRef
      b -> STM ()
newUpdate b
b
      if Bool -> Bool
not (TVar b
ref'' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TVar b]
pastRefs) then do
        b -> STM ()
update'' <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
updateRef''
        forall a. TVar a -> a -> STM ()
writeTVar TVar (b -> STM ())
updateRef'' \b
b -> do
          b -> STM ()
update'' b
b
          (TVar b
tvar, [TVar b]
_tvars) <- forall a. TVar a -> STM a
readTVar TVar (TVar b, [TVar b])
updateFromWhichRef
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TVar b
tvar forall a. Eq a => a -> a -> Bool
== TVar b
ref'') do
            b
b' <- forall a. TVar a -> STM a
readTVar TVar b
newRef
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (b
b' forall a. Eq a => a -> a -> Bool
/= b
b) do
              forall a. TVar a -> a -> STM ()
writeTVar TVar b
newRef b
b
              b -> STM ()
newUpdate <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
newUpdateRef
              b -> STM ()
newUpdate b
b
        forall a. TVar a -> a -> STM ()
writeTVar TVar (TVar b, [TVar b])
updateFromWhichRef (TVar b
ref'', TVar b
ref'' forall a. a -> [a] -> [a]
: [TVar b]
pastRefs)
      else forall a. TVar a -> a -> STM ()
writeTVar TVar (TVar b, [TVar b])
updateFromWhichRef (TVar b
ref'', [TVar b]
pastRefs)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (mutability :: Mutability) a.
TVar a -> TVar (a -> STM ()) -> Incremental mutability a
Incremental TVar b
newRef TVar (b -> STM ())
newUpdateRef)

-- | Add monitoring hooks which can do arbitrary actions in 'STM' with the
-- changed value whenever this 'Incremental' is updated. One useful example
-- of this is used for testing this module, recording the 'history' of an
-- 'Incremental' computation:
--
-- @
-- history :: Incremental m b -> STM (STM [b])
-- history i = do
--   x <- observe i
--   h <- newTVar [x]
--   onUpdate i \b -> do
--     bs <- readTVar h
--     writeTVar h (b : bs)
--   pure (readTVar h)
-- @
onUpdate
  :: Incremental m b
  -> (b -> STM ())
  -> STM ()
onUpdate :: forall (m :: Mutability) b.
Incremental m b -> (b -> STM ()) -> STM ()
onUpdate (Incremental TVar b
_ref TVar (b -> STM ())
updateRef) b -> STM ()
monitoring = do
  b -> STM ()
update <- forall a. TVar a -> STM a
readTVar TVar (b -> STM ())
updateRef
  forall a. TVar a -> a -> STM ()
writeTVar TVar (b -> STM ())
updateRef \b
b -> do
    b -> STM ()
update b
b
    b -> STM ()
monitoring b
b
    
-- | Instruments the given 'Incremental' with functionality to save the
-- history of its values. This is useful for testing.
history
  :: Incremental m b
  -> STM (STM [b])
history :: forall (m :: Mutability) b. Incremental m b -> STM (STM [b])
history Incremental m b
i = do
  b
x <- forall (m :: Mutability) a. Incremental m a -> STM a
observe Incremental m b
i
  TVar [b]
h <- forall a. a -> STM (TVar a)
newTVar [b
x]
  forall (m :: Mutability) b.
Incremental m b -> (b -> STM ()) -> STM ()
onUpdate Incremental m b
i \b
b -> do
    [b]
bs <- forall a. TVar a -> STM a
readTVar TVar [b]
h
    forall a. TVar a -> a -> STM ()
writeTVar TVar [b]
h (b
b forall a. a -> [a] -> [a]
: [b]
bs)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. TVar a -> STM a
readTVar TVar [b]
h)