-----------------------------------------------------------------------------

-- |

-- Module      :  Data.Propagator.ST

-- Copyright   :  (c) Michael Szvetits, 2024

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

-- This module exports ST-based types and functions needed to create cells,

-- manipulate their data and wire them up for data propagation.

-----------------------------------------------------------------------------

module Data.Propagator.ST
  ( -- * Networks

    Propagation
  , undo
  , succeeded
    -- ** Cells

  , Cell
  , Change(..)
  , cell
  , readCell
  , writeCell
  , label
    -- ** Connections

  , connect
  , sync
  , syncWith
  , propagate
  , propagateMany
    -- *** Numeric

  , plus
  , minus
  , times
  , timesWith
  , abs
  , absWith
  , negate
  , signum
  , signumWith
  ) where

-- base

import Control.Monad    (forM)
import Control.Monad.ST (ST)
import Data.STRef       (STRef, modifySTRef, newSTRef, readSTRef, writeSTRef)

import Prelude hiding (abs, negate, signum)
import Prelude qualified as Prelude

import Data.Propagator.Change (Change(..))

-- | The result of a propagation which allows to rollback changes and inspect

-- its success.

data Propagation s = Propagation
  { forall s. Propagation s -> ST s ()
undo :: ST s ()
    -- ^ An action that reverts all cell changes of a propagation (both direct

    -- and transitive ones).

  , forall s. Propagation s -> Bool
succeeded :: Bool
    -- ^ 'True' if the propagation was successful (i.e., it did not lead to a

    -- cell change that is 'Incompatible'), otherwise 'False'.

    --

    -- Note that unsuccessful propagations are not automatically reverted. Use

    -- 'undo' to do this.

  }

addUndo :: ST s () -> Propagation s -> Propagation s
addUndo :: forall s. ST s () -> Propagation s -> Propagation s
addUndo ST s ()
action (Propagation ST s ()
us Bool
r) = ST s () -> Bool -> Propagation s
forall s. ST s () -> Bool -> Propagation s
Propagation (ST s ()
us ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ST s ()
action) Bool
r

type Propagator s a = a -> ST s (Propagation s)

-- | The type of a cell holding a value of type @a@. The type parameter @s@

-- serves to keep the internal states of different cell networks separate from

-- each other (see 'ST' for details).

data Cell s a = Cell
  { forall s a. Cell s a -> a -> a -> Change a
_join    :: a -> a -> Change a
  , forall s a. Cell s a -> STRef s a
valueRef :: STRef s a
  , forall s a. Cell s a -> STRef s (Propagator s a)
propRef  :: STRef s (Propagator s a)
  }

instance Eq (Cell s a) where
  Cell a -> a -> Change a
_ STRef s a
lr STRef s (Propagator s a)
_ == :: Cell s a -> Cell s a -> Bool
== Cell a -> a -> Change a
_ STRef s a
rr STRef s (Propagator s a)
_ = STRef s a
lr STRef s a -> STRef s a -> Bool
forall a. Eq a => a -> a -> Bool
== STRef s a
rr

-- | Constructs a new cell with a given initial value and a function which

-- defines how to react if a new value is about to be written to the cell.

cell :: a                    -- ^ The initial value of the cell.

     -> (a -> a -> Change a) -- ^ A function that describes how to join

                             --   an existing cell value with a new one that

                             --   the cell has received via propagation.

     -> ST s (Cell s a)      -- ^ The newly constructed cell.

cell :: forall a s. a -> (a -> a -> Change a) -> ST s (Cell s a)
cell a
value a -> a -> Change a
f = do
  STRef s a
v <- a -> ST s (STRef s a)
forall a s. a -> ST s (STRef s a)
newSTRef a
value
  STRef s (Propagator s a)
n <- Propagator s a -> ST s (STRef s (Propagator s a))
forall a s. a -> ST s (STRef s a)
newSTRef Propagator s a
forall s a. Propagator s a
emptyPropagator
  Cell s a -> ST s (Cell s a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a -> a -> Change a)
-> STRef s a -> STRef s (Propagator s a) -> Cell s a
forall s a.
(a -> a -> Change a)
-> STRef s a -> STRef s (Propagator s a) -> Cell s a
Cell a -> a -> Change a
f STRef s a
v STRef s (Propagator s a)
n)

-- | Reads the value of a specific cell.

readCell :: Cell s a -> ST s a
readCell :: forall s a. Cell s a -> ST s a
readCell = STRef s a -> ST s a
forall s a. STRef s a -> ST s a
readSTRef (STRef s a -> ST s a)
-> (Cell s a -> STRef s a) -> Cell s a -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell s a -> STRef s a
forall s a. Cell s a -> STRef s a
valueRef

-- | Writes a new value to a specific cell and starts to propagate potential

-- changes through the network of connected cells.

writeCell :: a -> Cell s a -> ST s (Propagation s)
writeCell :: forall a s. a -> Cell s a -> ST s (Propagation s)
writeCell a
new (Cell a -> a -> Change a
f STRef s a
vRef STRef s (Propagator s a)
pRef) = do
  a
old <- STRef s a -> ST s a
forall s a. STRef s a -> ST s a
readSTRef STRef s a
vRef
  case a -> a -> Change a
f a
old a
new of
    Unchanged a
_  -> Propagation s -> ST s (Propagation s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Propagation s
forall s. Propagation s
success
    Change a
Incompatible -> Propagation s -> ST s (Propagation s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Propagation s
forall s. Propagation s
failure
    Changed a
n    -> do
      STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s a
vRef a
n
      Propagator s a
propagator  <- STRef s (Propagator s a) -> ST s (Propagator s a)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Propagator s a)
pRef
      Propagation s
propagation <- Propagator s a
propagator a
n
      Propagation s -> ST s (Propagation s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ST s () -> Propagation s -> Propagation s
forall s. ST s () -> Propagation s -> Propagation s
addUndo (STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s a
vRef a
old) Propagation s
propagation)

emptyPropagator :: Propagator s a
emptyPropagator :: forall s a. Propagator s a
emptyPropagator = ST s (Propagation s) -> a -> ST s (Propagation s)
forall a b. a -> b -> a
const (Propagation s -> ST s (Propagation s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Propagation s
forall s. Propagation s
success)

failure :: Propagation s
failure :: forall s. Propagation s
failure = ST s () -> Bool -> Propagation s
forall s. ST s () -> Bool -> Propagation s
Propagation (() -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Bool
False

success :: Propagation s
success :: forall s. Propagation s
success = ST s () -> Bool -> Propagation s
forall s. ST s () -> Bool -> Propagation s
Propagation (() -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Bool
True

attach :: Propagator s a -> STRef s (Propagator s a) -> ST s ()
attach :: forall s a. Propagator s a -> STRef s (Propagator s a) -> ST s ()
attach Propagator s a
newProp STRef s (Propagator s a)
pRef =
  STRef s (Propagator s a)
-> (Propagator s a -> Propagator s a) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Propagator s a)
pRef ((Propagator s a -> Propagator s a) -> ST s ())
-> (Propagator s a -> Propagator s a) -> ST s ()
forall a b. (a -> b) -> a -> b
$
    \Propagator s a
currentProp a
a ->
      ST s (Propagation s)
-> ST s (Propagation s) -> ST s (Propagation s)
forall s.
ST s (Propagation s)
-> ST s (Propagation s) -> ST s (Propagation s)
chain (Propagator s a
currentProp a
a) (Propagator s a
newProp a
a)

-- | Connects a source cell to a target cell in order to propagate changes

-- from the source to the target.

--

-- Note that newly connected cells do not start to propagate changes

-- immediately after wiring up. Use 'propagate' or 'propagateMany' to do this.

connect :: Cell s a      -- ^ The source cell.

        -> Cell s b      -- ^ The target cell.

        -> (a -> ST s b) -- ^ A function that describes how the value for the

                         --   target cell is constructed, based on the value of

                         --   the source cell.

        -> ST s ()       -- ^ Note that no propagation takes place (i.e., no

                         --   'Propagation' is returned).

connect :: forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
source Cell s b
target a -> ST s b
f =
  (Propagator s a -> STRef s (Propagator s a) -> ST s ())
-> STRef s (Propagator s a) -> Propagator s a -> ST s ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Propagator s a -> STRef s (Propagator s a) -> ST s ()
forall s a. Propagator s a -> STRef s (Propagator s a) -> ST s ()
attach (Cell s a -> STRef s (Propagator s a)
forall s a. Cell s a -> STRef s (Propagator s a)
propRef Cell s a
source) (Propagator s a -> ST s ()) -> Propagator s a -> ST s ()
forall a b. (a -> b) -> a -> b
$
    \a
a -> do
      b
newValue <- a -> ST s b
f a
a
      b -> Cell s b -> ST s (Propagation s)
forall a s. a -> Cell s a -> ST s (Propagation s)
writeCell b
newValue Cell s b
target

-- | Connects and synchronizes two cells, i.e. new values are propagated from

-- the source to the target cell, and vice versa. Short form of 'syncWith'

-- 'id' 'id'.

--

-- Note that newly connected cells do not start to propagate changes

-- immediately after wiring up. Use 'propagate' or 'propagateMany' to do this.

sync :: Cell s a -> Cell s a -> ST s ()
sync :: forall s a. Cell s a -> Cell s a -> ST s ()
sync = (a -> a) -> (a -> a) -> Cell s a -> Cell s a -> ST s ()
forall a b s.
(a -> b) -> (b -> a) -> Cell s a -> Cell s b -> ST s ()
syncWith a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id

-- | Connects and synchronizes two cells using two translation functions @f@

-- and @g@, i.e. new values are propagated from the source to the target cell

-- using @f@, and vice versa using @g@.

--

-- Note that newly connected cells do not start to propagate changes

-- immediately after wiring up. Use 'propagate' or 'propagateMany' to do this.

syncWith :: (a -> b) -> (b -> a) -> Cell s a -> Cell s b -> ST s ()
syncWith :: forall a b s.
(a -> b) -> (b -> a) -> Cell s a -> Cell s b -> ST s ()
syncWith a -> b
f b -> a
g Cell s a
left Cell s b
right = do
  Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
left Cell s b
right (b -> ST s b
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> ST s b) -> (a -> b) -> a -> ST s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  Cell s b -> Cell s a -> (b -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s b
right Cell s a
left (a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> (b -> a) -> b -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g)

-- | Propagates the value of a specific cell to its connected cells in a

-- transitive manner. The propagation ends if no more cell changes occur or if

-- an 'Incompatible' cell value change is encountered.

propagate :: Cell s a -> ST s (Propagation s)
propagate :: forall s a. Cell s a -> ST s (Propagation s)
propagate Cell s a
source = do
  a
value      <- STRef s a -> ST s a
forall s a. STRef s a -> ST s a
readSTRef (Cell s a -> STRef s a
forall s a. Cell s a -> STRef s a
valueRef Cell s a
source)
  Propagator s a
propagator <- STRef s (Propagator s a) -> ST s (Propagator s a)
forall s a. STRef s a -> ST s a
readSTRef (Cell s a -> STRef s (Propagator s a)
forall s a. Cell s a -> STRef s (Propagator s a)
propRef Cell s a
source)
  Propagator s a
propagator a
value

-- | Propagates the values of specific cells to their connected cells in a

-- transitive manner. The propagation ends if no more cell changes occur or if

-- an 'Incompatible' cell value change is encountered.

propagateMany :: [Cell s a] -> ST s (Propagation s)
propagateMany :: forall s a. [Cell s a] -> ST s (Propagation s)
propagateMany []     = Propagation s -> ST s (Propagation s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Propagation s
forall s. Propagation s
success
propagateMany (Cell s a
c:[Cell s a]
cs) = ST s (Propagation s)
-> ST s (Propagation s) -> ST s (Propagation s)
forall s.
ST s (Propagation s)
-> ST s (Propagation s) -> ST s (Propagation s)
chain (Cell s a -> ST s (Propagation s)
forall s a. Cell s a -> ST s (Propagation s)
propagate Cell s a
c) ([Cell s a] -> ST s (Propagation s)
forall s a. [Cell s a] -> ST s (Propagation s)
propagateMany [Cell s a]
cs)

chain :: ST s (Propagation s) -> ST s (Propagation s) -> ST s (Propagation s)
chain :: forall s.
ST s (Propagation s)
-> ST s (Propagation s) -> ST s (Propagation s)
chain ST s (Propagation s)
prop ST s (Propagation s)
continue = do
  Propagation s
propagation <- ST s (Propagation s)
prop
  if Propagation s -> Bool
forall s. Propagation s -> Bool
succeeded Propagation s
propagation then do
    Propagation s
rest <- ST s (Propagation s)
continue
    Propagation s -> ST s (Propagation s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ST s () -> Propagation s -> Propagation s
forall s. ST s () -> Propagation s -> Propagation s
addUndo (Propagation s -> ST s ()
forall s. Propagation s -> ST s ()
undo Propagation s
propagation) Propagation s
rest)
  else
    Propagation s -> ST s (Propagation s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Propagation s
propagation

-- | If the content of a @Cell s a@ is an accumulation of multiple values @[b]@,

-- and every value @b@ itself can be used as content @a@ for the cell, then we

-- can write every value @b@ one after another to the cell and check if the

-- network converges to a successful state.

--

-- As a result, we can enumerate all possible combinations of valid values for

-- a given set of cells. This is often used in constraint solving algorithms.

label :: (a -> [b]) -- ^ A function which extracts testable values from a cell

                    --   content.

      -> (b -> a)   -- ^ A function which translates a testable value into a

                    --   value which can be written back to the cell.

      -> [Cell s a] -- ^ The set of cells for which the values are enumerated.

      -> ST s [[b]] -- ^ Returns all valid assignments for the given cells.

label :: forall a b s. (a -> [b]) -> (b -> a) -> [Cell s a] -> ST s [[b]]
label a -> [b]
elems b -> a
reify [Cell s a]
cells = [b] -> [Cell s a] -> ST s [[b]]
forall {s}. [b] -> [Cell s a] -> ST s [[b]]
solve [] ([Cell s a] -> [Cell s a]
forall a. [a] -> [a]
reverse [Cell s a]
cells)
  where
    solve :: [b] -> [Cell s a] -> ST s [[b]]
solve [b]
current []     = [[b]] -> ST s [[b]]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[b]
current]
    solve [b]
current (Cell s a
c:[Cell s a]
cs) = do
      a
cellValue <- Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
c
      [[[b]]]
solutions <-
        [b] -> (b -> ST s [[b]]) -> ST s [[[b]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (a -> [b]
elems a
cellValue) ((b -> ST s [[b]]) -> ST s [[[b]]])
-> (b -> ST s [[b]]) -> ST s [[[b]]]
forall a b. (a -> b) -> a -> b
$ \b
v -> do
          Propagation s
propagation <- a -> Cell s a -> ST s (Propagation s)
forall a s. a -> Cell s a -> ST s (Propagation s)
writeCell (b -> a
reify b
v) Cell s a
c
          [[b]]
vSolutions <-
            if Propagation s -> Bool
forall s. Propagation s -> Bool
succeeded Propagation s
propagation then
              [b] -> [Cell s a] -> ST s [[b]]
solve (b
vb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
current) [Cell s a]
cs
            else
              [[b]] -> ST s [[b]]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          Propagation s -> ST s ()
forall s. Propagation s -> ST s ()
undo Propagation s
propagation
          [[b]] -> ST s [[b]]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[b]]
vSolutions
      [[b]] -> ST s [[b]]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[[b]]] -> [[b]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[b]]]
solutions)

-- | @plus a b c@ connects three cells using the following propagation schema:

--

-- * @a + b@ is propagated to @c@ if @a@ or @b@ changes.

-- * @c - b@ is propagated to @a@ if @b@ or @c@ changes.

-- * @c - a@ is propagated to @b@ if @a@ or @c@ changes.

plus :: Num a => Cell s a -> Cell s a -> Cell s a -> ST s ()
plus :: forall a s. Num a => Cell s a -> Cell s a -> Cell s a -> ST s ()
plus Cell s a
left Cell s a
right Cell s a
result = do
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
left Cell s a
result  (\a
lv -> (a
lv +)      (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
right)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
left Cell s a
right   (\a
lv -> a -> a -> a
forall a. Num a => a -> a -> a
subtract a
lv (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
result)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
right Cell s a
result (\a
rv -> (a -> a -> a
forall a. Num a => a -> a -> a
+ a
rv)      (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
left)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
right Cell s a
left   (\a
rv -> a -> a -> a
forall a. Num a => a -> a -> a
subtract a
rv (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
result)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
result Cell s a
left  (\a
sv -> (a
sv -)      (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
right)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
result Cell s a
right (\a
sv -> (a
sv -)      (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
left)

-- | @minus a b c@ connects three cells using the following propagation schema:

--

-- * @a - b@ is propagated to @c@ if @a@ or @b@ changes.

-- * @b + c@ is propagated to @a@ if @b@ or @c@ changes.

-- * @a - c@ is propagated to @b@ if @a@ or @c@ changes.

minus :: Num a => Cell s a -> Cell s a -> Cell s a -> ST s ()
minus :: forall a s. Num a => Cell s a -> Cell s a -> Cell s a -> ST s ()
minus Cell s a
left Cell s a
right Cell s a
result = do
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
left Cell s a
result  (\a
lv -> (a
lv -)      (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
right)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
left Cell s a
right   (\a
lv -> (a
lv -)      (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
result)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
right Cell s a
result (\a
rv -> a -> a -> a
forall a. Num a => a -> a -> a
subtract a
rv (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
left)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
right Cell s a
left   (\a
rv -> (a -> a -> a
forall a. Num a => a -> a -> a
+ a
rv)      (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
result)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
result Cell s a
left  (\a
dv -> (a -> a -> a
forall a. Num a => a -> a -> a
+ a
dv)      (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
right)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
result Cell s a
right (\a
dv -> a -> a -> a
forall a. Num a => a -> a -> a
subtract a
dv (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
left)

-- | @times a b c@ connects three cells using the following propagation schema:

--

-- * @a * b@ is propagated to @c@ if @a@ or @b@ changes.

times :: Num a => Cell s a -> Cell s a -> Cell s a -> ST s ()
times :: forall a s. Num a => Cell s a -> Cell s a -> Cell s a -> ST s ()
times Cell s a
left Cell s a
right Cell s a
result = do
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
left Cell s a
result  (\a
lv -> (a
lv *) (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
right)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
right Cell s a
result (\a
rv -> (a -> a -> a
forall a. Num a => a -> a -> a
* a
rv) (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
left)

-- | @timesWith divOp a b c@ connects three cells using the following propagation schema:

--

-- * @a * b@ is propagated to @c@ if @a@ or @b@ changes.

-- * @divOp c b@ is propagated to @a@ if @b@ or @c@ changes.

-- * @divOp c a@ is propagated to @b@ if @a@ or @c@ changes.

timesWith :: Num a => (a -> a -> a) -> Cell s a -> Cell s a -> Cell s a -> ST s ()
timesWith :: forall a s.
Num a =>
(a -> a -> a) -> Cell s a -> Cell s a -> Cell s a -> ST s ()
timesWith a -> a -> a
divOp Cell s a
left Cell s a
right Cell s a
result = do
  Cell s a -> Cell s a -> Cell s a -> ST s ()
forall a s. Num a => Cell s a -> Cell s a -> Cell s a -> ST s ()
times Cell s a
left Cell s a
right Cell s a
result
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
left Cell s a
right   (\a
lv -> (a -> a -> a
`divOp` a
lv) (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
result)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
right Cell s a
left   (\a
rv -> (a -> a -> a
`divOp` a
rv) (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
result)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
result Cell s a
left  (\a
pv -> (a
pv `divOp`) (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
right)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
result Cell s a
right (\a
pv -> (a
pv `divOp`) (a -> a) -> ST s a -> ST s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell s a -> ST s a
forall s a. Cell s a -> ST s a
readCell Cell s a
left)

-- | @abs a b@ connects two cells using the following propagation schema:

--

-- * @|a|@ is propagated to @b@ if @a@ changes.

abs :: Num a => Cell s a -> Cell s a -> ST s ()
abs :: forall a s. Num a => Cell s a -> Cell s a -> ST s ()
abs Cell s a
c Cell s a
result =
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
c Cell s a
result (a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> (a -> a) -> a -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.abs)

-- | @absWith inv a b@ connects two cells using the following propagation schema:

--

-- * @|a|@ is propagated to @b@ if @a@ changes.

-- * @inv b@ is propagated to @a@ if @b@ changes.

absWith :: Num a => (a -> a) -> Cell s a -> Cell s a -> ST s ()
absWith :: forall a s. Num a => (a -> a) -> Cell s a -> Cell s a -> ST s ()
absWith a -> a
inv Cell s a
c Cell s a
result = do
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
c Cell s a
result (a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> (a -> a) -> a -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.abs)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
result Cell s a
c (a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> (a -> a) -> a -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
inv)

-- | @negate a b@ connects two cells using the following propagation schema:

--

-- * @-a@ is propagated to @b@ if @a@ changes.

-- * @-b@ is propagated to @a@ if @b@ changes.

negate :: Num a => Cell s a -> Cell s a -> ST s ()
negate :: forall a s. Num a => Cell s a -> Cell s a -> ST s ()
negate Cell s a
c Cell s a
result = do
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
c Cell s a
result (a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> (a -> a) -> a -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.negate)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
result Cell s a
c (a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> (a -> a) -> a -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.negate)

-- | @signum a b@ connects two cells using the following propagation schema:

--

-- * @Prelude.signum a@ is propagated to @b@ if @a@ changes.

signum :: Num a => Cell s a -> Cell s a -> ST s ()
signum :: forall a s. Num a => Cell s a -> Cell s a -> ST s ()
signum Cell s a
c Cell s a
result =
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
c Cell s a
result (a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> (a -> a) -> a -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.signum)

-- | @signumWith inv a b@ connects two cells using the following propagation schema:

--

-- * @Prelude.signum a@ is propagated to @b@ if @a@ changes.

-- * @inv b@ is propagated to @a@ if @b@ changes.

signumWith :: Num a => (a -> a) -> Cell s a -> Cell s a -> ST s ()
signumWith :: forall a s. Num a => (a -> a) -> Cell s a -> Cell s a -> ST s ()
signumWith a -> a
inv Cell s a
c Cell s a
result = do
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
c Cell s a
result (a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> (a -> a) -> a -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.signum)
  Cell s a -> Cell s a -> (a -> ST s a) -> ST s ()
forall s a b. Cell s a -> Cell s b -> (a -> ST s b) -> ST s ()
connect Cell s a
result Cell s a
c (a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> (a -> a) -> a -> ST s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
inv)