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

-- |

-- Module      :  Data.Propagator

-- Copyright   :  (c) Michael Szvetits, 2024

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

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

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

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

module Data.Propagator
  ( -- * Networks

    Network
  , empty
  , Error(..)
  , Propagator
  , runPropagator
    -- ** Cells

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

  , ConnectKey
  , ConnectState(..)
  , connect
  , connect_
  , sync
  , sync_
  , syncWith
  , syncWith_
  , combine
  , combine_
  , combineMany
  , combineMany_
  , distribute
  , distribute_
  , manyToMany
  , manyToMany_
  , disconnect
    -- *** Numeric

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

-- base

import Control.Monad        (forM, void)
import Data.Foldable        (traverse_)
import Data.Functor.Compose (Compose(..))

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

-- containers

import Data.IntMap.Strict qualified as M
import Data.IntSet        qualified as S

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

-- | Represents a network cell holding a value of type @a@.

data Cell a = Cell
  { forall a. Cell a -> a
value :: !a
  , forall a. Cell a -> a -> a -> Change a
update :: !(a -> a -> Change a)
  , forall a. Cell a -> IntSet
subscribers :: !S.IntSet
  , forall a. Cell a -> IntSet
incomings :: !S.IntSet
  }

-- | Represents a unique identification of a network cell.

newtype CellKey = CellKey { CellKey -> Int
unCellKey :: Int }
  deriving (CellKey -> CellKey -> Bool
(CellKey -> CellKey -> Bool)
-> (CellKey -> CellKey -> Bool) -> Eq CellKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellKey -> CellKey -> Bool
== :: CellKey -> CellKey -> Bool
$c/= :: CellKey -> CellKey -> Bool
/= :: CellKey -> CellKey -> Bool
Eq, Eq CellKey
Eq CellKey =>
(CellKey -> CellKey -> Ordering)
-> (CellKey -> CellKey -> Bool)
-> (CellKey -> CellKey -> Bool)
-> (CellKey -> CellKey -> Bool)
-> (CellKey -> CellKey -> Bool)
-> (CellKey -> CellKey -> CellKey)
-> (CellKey -> CellKey -> CellKey)
-> Ord CellKey
CellKey -> CellKey -> Bool
CellKey -> CellKey -> Ordering
CellKey -> CellKey -> CellKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CellKey -> CellKey -> Ordering
compare :: CellKey -> CellKey -> Ordering
$c< :: CellKey -> CellKey -> Bool
< :: CellKey -> CellKey -> Bool
$c<= :: CellKey -> CellKey -> Bool
<= :: CellKey -> CellKey -> Bool
$c> :: CellKey -> CellKey -> Bool
> :: CellKey -> CellKey -> Bool
$c>= :: CellKey -> CellKey -> Bool
>= :: CellKey -> CellKey -> Bool
$cmax :: CellKey -> CellKey -> CellKey
max :: CellKey -> CellKey -> CellKey
$cmin :: CellKey -> CellKey -> CellKey
min :: CellKey -> CellKey -> CellKey
Ord, Int -> CellKey -> ShowS
[CellKey] -> ShowS
CellKey -> String
(Int -> CellKey -> ShowS)
-> (CellKey -> String) -> ([CellKey] -> ShowS) -> Show CellKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellKey -> ShowS
showsPrec :: Int -> CellKey -> ShowS
$cshow :: CellKey -> String
show :: CellKey -> String
$cshowList :: [CellKey] -> ShowS
showList :: [CellKey] -> ShowS
Show)

data Prop a = Prop
  { forall a. Prop a -> [CellKey]
sources :: ![CellKey]
  , forall a. Prop a -> [CellKey]
targets :: ![CellKey]
  , forall a. Prop a -> ConnectKey -> IntSet -> Propagator a ()
action :: !(ConnectKey -> S.IntSet -> Propagator a ())
  }

-- | Represents a unique identification of a network connection.

newtype ConnectKey = ConnectKey { ConnectKey -> Int
unConnectKey :: Int }
  deriving (ConnectKey -> ConnectKey -> Bool
(ConnectKey -> ConnectKey -> Bool)
-> (ConnectKey -> ConnectKey -> Bool) -> Eq ConnectKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectKey -> ConnectKey -> Bool
== :: ConnectKey -> ConnectKey -> Bool
$c/= :: ConnectKey -> ConnectKey -> Bool
/= :: ConnectKey -> ConnectKey -> Bool
Eq, Eq ConnectKey
Eq ConnectKey =>
(ConnectKey -> ConnectKey -> Ordering)
-> (ConnectKey -> ConnectKey -> Bool)
-> (ConnectKey -> ConnectKey -> Bool)
-> (ConnectKey -> ConnectKey -> Bool)
-> (ConnectKey -> ConnectKey -> Bool)
-> (ConnectKey -> ConnectKey -> ConnectKey)
-> (ConnectKey -> ConnectKey -> ConnectKey)
-> Ord ConnectKey
ConnectKey -> ConnectKey -> Bool
ConnectKey -> ConnectKey -> Ordering
ConnectKey -> ConnectKey -> ConnectKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConnectKey -> ConnectKey -> Ordering
compare :: ConnectKey -> ConnectKey -> Ordering
$c< :: ConnectKey -> ConnectKey -> Bool
< :: ConnectKey -> ConnectKey -> Bool
$c<= :: ConnectKey -> ConnectKey -> Bool
<= :: ConnectKey -> ConnectKey -> Bool
$c> :: ConnectKey -> ConnectKey -> Bool
> :: ConnectKey -> ConnectKey -> Bool
$c>= :: ConnectKey -> ConnectKey -> Bool
>= :: ConnectKey -> ConnectKey -> Bool
$cmax :: ConnectKey -> ConnectKey -> ConnectKey
max :: ConnectKey -> ConnectKey -> ConnectKey
$cmin :: ConnectKey -> ConnectKey -> ConnectKey
min :: ConnectKey -> ConnectKey -> ConnectKey
Ord, Int -> ConnectKey -> ShowS
[ConnectKey] -> ShowS
ConnectKey -> String
(Int -> ConnectKey -> ShowS)
-> (ConnectKey -> String)
-> ([ConnectKey] -> ShowS)
-> Show ConnectKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectKey -> ShowS
showsPrec :: Int -> ConnectKey -> ShowS
$cshow :: ConnectKey -> String
show :: ConnectKey -> String
$cshowList :: [ConnectKey] -> ShowS
showList :: [ConnectKey] -> ShowS
Show)

-- | A network consists of cells and connections which propagate data between them.

data Network a = Network
  { forall a. Network a -> CellKey
nextCellKey :: !CellKey
  , forall a. Network a -> ConnectKey
nextConnectKey :: !ConnectKey
  , forall a. Network a -> IntMap (Cell a)
cells :: !(M.IntMap (Cell a))
  , forall a. Network a -> IntMap (Prop a)
propagators :: !(M.IntMap (Prop a))
  }

-- | Network modifications and data propagations are captured by the 'Propagator' monad.

newtype Propagator a b =
  Propagator
    { forall a b.
Propagator a b -> Network a -> Either (Error a) (Network a, b)
runPropagator :: Network a -> Either (Error a) (Network a, b)
      -- ^ Applies modifications captured by the propagator monad to a network,

      -- thus producing a new network if no error occurred.

    }
  deriving (forall a b. (a -> b) -> Propagator a a -> Propagator a b)
-> (forall a b. a -> Propagator a b -> Propagator a a)
-> Functor (Propagator a)
forall a b. a -> Propagator a b -> Propagator a a
forall a b. (a -> b) -> Propagator a a -> Propagator a b
forall a a b. a -> Propagator a b -> Propagator a a
forall a a b. (a -> b) -> Propagator a a -> Propagator a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> Propagator a a -> Propagator a b
fmap :: forall a b. (a -> b) -> Propagator a a -> Propagator a b
$c<$ :: forall a a b. a -> Propagator a b -> Propagator a a
<$ :: forall a b. a -> Propagator a b -> Propagator a a
Functor

instance Applicative (Propagator a) where
  pure :: forall a. a -> Propagator a a
pure a
a =
    (Network a -> Either (Error a) (Network a, a)) -> Propagator a a
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator (\Network a
net -> (Network a, a) -> Either (Error a) (Network a, a)
forall a b. b -> Either a b
Right (Network a
net, a
a))
  Propagator a (a -> b)
pf <*> :: forall a b.
Propagator a (a -> b) -> Propagator a a -> Propagator a b
<*> Propagator a a
pa =
    (Network a -> Either (Error a) (Network a, b)) -> Propagator a b
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, b)) -> Propagator a b)
-> (Network a -> Either (Error a) (Network a, b)) -> Propagator a b
forall a b. (a -> b) -> a -> b
$ \Network a
net -> do
      (Network a
net',a -> b
f) <- Propagator a (a -> b)
-> Network a -> Either (Error a) (Network a, a -> b)
forall a b.
Propagator a b -> Network a -> Either (Error a) (Network a, b)
runPropagator Propagator a (a -> b)
pf Network a
net
      (Network a
net'',a
a) <- Propagator a a -> Network a -> Either (Error a) (Network a, a)
forall a b.
Propagator a b -> Network a -> Either (Error a) (Network a, b)
runPropagator Propagator a a
pa Network a
net'
      (Network a, b) -> Either (Error a) (Network a, b)
forall a. a -> Either (Error a) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network a
net'', a -> b
f a
a)

instance Monad (Propagator a) where
  Propagator Network a -> Either (Error a) (Network a, a)
f >>= :: forall a b.
Propagator a a -> (a -> Propagator a b) -> Propagator a b
>>= a -> Propagator a b
g =
    (Network a -> Either (Error a) (Network a, b)) -> Propagator a b
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, b)) -> Propagator a b)
-> (Network a -> Either (Error a) (Network a, b)) -> Propagator a b
forall a b. (a -> b) -> a -> b
$ \Network a
net -> do
      (Network a
net',a
a) <- Network a -> Either (Error a) (Network a, a)
f Network a
net
      Propagator a b -> Network a -> Either (Error a) (Network a, b)
forall a b.
Propagator a b -> Network a -> Either (Error a) (Network a, b)
runPropagator (a -> Propagator a b
g a
a) Network a
net'

-- | When connecting cells, the 'ConnectState' defines the initial behaviour of the connection.

data ConnectState
  = Live -- ^ The connection immediately starts to propagate data between the connected cells.

  | Idle -- ^ The connection is established, but no initial data propagation takes place.

  deriving (ConnectState -> ConnectState -> Bool
(ConnectState -> ConnectState -> Bool)
-> (ConnectState -> ConnectState -> Bool) -> Eq ConnectState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectState -> ConnectState -> Bool
== :: ConnectState -> ConnectState -> Bool
$c/= :: ConnectState -> ConnectState -> Bool
/= :: ConnectState -> ConnectState -> Bool
Eq, Eq ConnectState
Eq ConnectState =>
(ConnectState -> ConnectState -> Ordering)
-> (ConnectState -> ConnectState -> Bool)
-> (ConnectState -> ConnectState -> Bool)
-> (ConnectState -> ConnectState -> Bool)
-> (ConnectState -> ConnectState -> Bool)
-> (ConnectState -> ConnectState -> ConnectState)
-> (ConnectState -> ConnectState -> ConnectState)
-> Ord ConnectState
ConnectState -> ConnectState -> Bool
ConnectState -> ConnectState -> Ordering
ConnectState -> ConnectState -> ConnectState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConnectState -> ConnectState -> Ordering
compare :: ConnectState -> ConnectState -> Ordering
$c< :: ConnectState -> ConnectState -> Bool
< :: ConnectState -> ConnectState -> Bool
$c<= :: ConnectState -> ConnectState -> Bool
<= :: ConnectState -> ConnectState -> Bool
$c> :: ConnectState -> ConnectState -> Bool
> :: ConnectState -> ConnectState -> Bool
$c>= :: ConnectState -> ConnectState -> Bool
>= :: ConnectState -> ConnectState -> Bool
$cmax :: ConnectState -> ConnectState -> ConnectState
max :: ConnectState -> ConnectState -> ConnectState
$cmin :: ConnectState -> ConnectState -> ConnectState
min :: ConnectState -> ConnectState -> ConnectState
Ord, Int -> ConnectState -> ShowS
[ConnectState] -> ShowS
ConnectState -> String
(Int -> ConnectState -> ShowS)
-> (ConnectState -> String)
-> ([ConnectState] -> ShowS)
-> Show ConnectState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectState -> ShowS
showsPrec :: Int -> ConnectState -> ShowS
$cshow :: ConnectState -> String
show :: ConnectState -> String
$cshowList :: [ConnectState] -> ShowS
showList :: [ConnectState] -> ShowS
Show)

failWith :: Error b -> Propagator b a
failWith :: forall b a. Error b -> Propagator b a
failWith Error b
e = (Network b -> Either (Error b) (Network b, a)) -> Propagator b a
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network b -> Either (Error b) (Network b, a)) -> Propagator b a)
-> (Network b -> Either (Error b) (Network b, a)) -> Propagator b a
forall a b. (a -> b) -> a -> b
$ \Network b
_ -> Error b -> Either (Error b) (Network b, a)
forall a b. a -> Either a b
Left Error b
e

addPropagator :: Prop a -> Propagator a ConnectKey
addPropagator :: forall a. Prop a -> Propagator a ConnectKey
addPropagator Prop a
prop =
  (Network a -> Either (Error a) (Network a, ConnectKey))
-> Propagator a ConnectKey
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, ConnectKey))
 -> Propagator a ConnectKey)
-> (Network a -> Either (Error a) (Network a, ConnectKey))
-> Propagator a ConnectKey
forall a b. (a -> b) -> a -> b
$ \Network a
net ->
    let
      key :: ConnectKey
key@(ConnectKey Int
nextInt) = Network a -> ConnectKey
forall a. Network a -> ConnectKey
nextConnectKey Network a
net
    in
      (Network a, ConnectKey) -> Either (Error a) (Network a, ConnectKey)
forall a b. b -> Either a b
Right
        ( Network a
net
            { nextConnectKey = ConnectKey (nextInt + 1)
            , propagators = M.insert nextInt prop (propagators net)
            }
        , ConnectKey
key
        )

getCell :: CellKey -> Propagator a (Cell a)
getCell :: forall a. CellKey -> Propagator a (Cell a)
getCell ck :: CellKey
ck@(CellKey Int
k) =
  (Network a -> Either (Error a) (Network a, Cell a))
-> Propagator a (Cell a)
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, Cell a))
 -> Propagator a (Cell a))
-> (Network a -> Either (Error a) (Network a, Cell a))
-> Propagator a (Cell a)
forall a b. (a -> b) -> a -> b
$ \Network a
net ->
    Error a
-> Maybe (Network a, Cell a)
-> Either (Error a) (Network a, Cell a)
forall b a. Error b -> Maybe a -> Either (Error b) a
toError (CellKey -> Error a
forall a. CellKey -> Error a
InvalidCell CellKey
ck) (Maybe (Network a, Cell a) -> Either (Error a) (Network a, Cell a))
-> Maybe (Network a, Cell a)
-> Either (Error a) (Network a, Cell a)
forall a b. (a -> b) -> a -> b
$ do
      Cell a
prop <- Int -> IntMap (Cell a) -> Maybe (Cell a)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
k (Network a -> IntMap (Cell a)
forall a. Network a -> IntMap (Cell a)
cells Network a
net)
      (Network a, Cell a) -> Maybe (Network a, Cell a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network a
net, Cell a
prop)

getPropagator :: ConnectKey -> Propagator a (Prop a)
getPropagator :: forall a. ConnectKey -> Propagator a (Prop a)
getPropagator key :: ConnectKey
key@(ConnectKey Int
k) =
  (Network a -> Either (Error a) (Network a, Prop a))
-> Propagator a (Prop a)
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, Prop a))
 -> Propagator a (Prop a))
-> (Network a -> Either (Error a) (Network a, Prop a))
-> Propagator a (Prop a)
forall a b. (a -> b) -> a -> b
$ \Network a
net ->
    Error a
-> Maybe (Network a, Prop a)
-> Either (Error a) (Network a, Prop a)
forall b a. Error b -> Maybe a -> Either (Error b) a
toError (ConnectKey -> Error a
forall a. ConnectKey -> Error a
InvalidConnect ConnectKey
key) (Maybe (Network a, Prop a) -> Either (Error a) (Network a, Prop a))
-> Maybe (Network a, Prop a)
-> Either (Error a) (Network a, Prop a)
forall a b. (a -> b) -> a -> b
$ do
      Prop a
prop <- Int -> IntMap (Prop a) -> Maybe (Prop a)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
k (Network a -> IntMap (Prop a)
forall a. Network a -> IntMap (Prop a)
propagators Network a
net)
      (Network a, Prop a) -> Maybe (Network a, Prop a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network a
net, Prop a
prop)

extractPropagator :: ConnectKey -> Propagator a (Prop a)
extractPropagator :: forall a. ConnectKey -> Propagator a (Prop a)
extractPropagator key :: ConnectKey
key@(ConnectKey Int
k) =
  (Network a -> Either (Error a) (Network a, Prop a))
-> Propagator a (Prop a)
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, Prop a))
 -> Propagator a (Prop a))
-> (Network a -> Either (Error a) (Network a, Prop a))
-> Propagator a (Prop a)
forall a b. (a -> b) -> a -> b
$ \Network a
net ->
    let
      (Maybe (Prop a)
maybeProp, IntMap (Prop a)
newPropagators) =
        (Int -> Prop a -> Maybe (Prop a))
-> Int -> IntMap (Prop a) -> (Maybe (Prop a), IntMap (Prop a))
forall a.
(Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
M.updateLookupWithKey (\Int
_ Prop a
_ -> Maybe (Prop a)
forall a. Maybe a
Nothing) Int
k (Network a -> IntMap (Prop a)
forall a. Network a -> IntMap (Prop a)
propagators Network a
net)
    in do
      Prop a
prop <- Error a -> Maybe (Prop a) -> Either (Error a) (Prop a)
forall b a. Error b -> Maybe a -> Either (Error b) a
toError (ConnectKey -> Error a
forall a. ConnectKey -> Error a
InvalidConnect ConnectKey
key) Maybe (Prop a)
maybeProp
      (Network a, Prop a) -> Either (Error a) (Network a, Prop a)
forall a. a -> Either (Error a) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network a
net { propagators = newPropagators }, Prop a
prop)

modifyCells :: (M.IntMap (Cell a) -> M.IntMap (Cell a)) -> Propagator a ()
modifyCells :: forall a. (IntMap (Cell a) -> IntMap (Cell a)) -> Propagator a ()
modifyCells IntMap (Cell a) -> IntMap (Cell a)
f =
  (Network a -> Either (Error a) (Network a, ())) -> Propagator a ()
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, ()))
 -> Propagator a ())
-> (Network a -> Either (Error a) (Network a, ()))
-> Propagator a ()
forall a b. (a -> b) -> a -> b
$ \Network a
net ->
    (Network a, ()) -> Either (Error a) (Network a, ())
forall a b. b -> Either a b
Right
      (Network a
net { cells = f (cells net) }, ())

modifyCell :: (Cell a -> Cell a) -> CellKey -> Propagator a ()
modifyCell :: forall a. (Cell a -> Cell a) -> CellKey -> Propagator a ()
modifyCell Cell a -> Cell a
f key :: CellKey
key@(CellKey Int
k) =
  (Network a -> Either (Error a) (Network a, ())) -> Propagator a ()
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, ()))
 -> Propagator a ())
-> (Network a -> Either (Error a) (Network a, ()))
-> Propagator a ()
forall a b. (a -> b) -> a -> b
$ \Network a
net -> do
    IntMap (Cell a)
newCells <- (Maybe (Cell a) -> Either (Error a) (Maybe (Cell a)))
-> Int -> IntMap (Cell a) -> Either (Error a) (IntMap (Cell a))
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Int -> IntMap a -> f (IntMap a)
M.alterF Maybe (Cell a) -> Either (Error a) (Maybe (Cell a))
forall {a}. Maybe (Cell a) -> Either (Error a) (Maybe (Cell a))
g Int
k (Network a -> IntMap (Cell a)
forall a. Network a -> IntMap (Cell a)
cells Network a
net)
    (Network a, ()) -> Either (Error a) (Network a, ())
forall a. a -> Either (Error a) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network a
net { cells = newCells }, ())
  where
    g :: Maybe (Cell a) -> Either (Error a) (Maybe (Cell a))
g Maybe (Cell a)
Nothing  = Error a -> Either (Error a) (Maybe (Cell a))
forall a b. a -> Either a b
Left (CellKey -> Error a
forall a. CellKey -> Error a
InvalidCell CellKey
key)
    g (Just Cell a
c) = Maybe (Cell a) -> Either (Error a) (Maybe (Cell a))
forall a b. b -> Either a b
Right (Maybe (Cell a) -> Either (Error a) (Maybe (Cell a)))
-> Maybe (Cell a) -> Either (Error a) (Maybe (Cell a))
forall a b. (a -> b) -> a -> b
$ Cell a -> Maybe (Cell a)
forall a. a -> Maybe a
Just (Cell a -> Cell a
f Cell a
c)

-- | Represents an empty network.

empty :: Network a
empty :: forall a. Network a
empty = CellKey
-> ConnectKey -> IntMap (Cell a) -> IntMap (Prop a) -> Network a
forall a.
CellKey
-> ConnectKey -> IntMap (Cell a) -> IntMap (Prop a) -> Network a
Network (Int -> CellKey
CellKey Int
0) (Int -> ConnectKey
ConnectKey Int
0) IntMap (Cell a)
forall a. IntMap a
M.empty IntMap (Prop a)
forall a. IntMap a
M.empty

-- | 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.

  -> Propagator a CellKey
  -- ^ The identification of the newly constructed cell.

cell :: forall a. a -> (a -> a -> Change a) -> Propagator a CellKey
cell a
initValue a -> a -> Change a
f =
  (Network a -> Either (Error a) (Network a, CellKey))
-> Propagator a CellKey
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, CellKey))
 -> Propagator a CellKey)
-> (Network a -> Either (Error a) (Network a, CellKey))
-> Propagator a CellKey
forall a b. (a -> b) -> a -> b
$ \Network a
net ->
    let
      nextKey :: CellKey
nextKey = Network a -> CellKey
forall a. Network a -> CellKey
nextCellKey Network a
net
      nextInt :: Int
nextInt = CellKey -> Int
unCellKey CellKey
nextKey
      newCell :: Cell a
newCell = a -> (a -> a -> Change a) -> IntSet -> IntSet -> Cell a
forall a. a -> (a -> a -> Change a) -> IntSet -> IntSet -> Cell a
Cell a
initValue a -> a -> Change a
f IntSet
S.empty IntSet
S.empty
      net' :: Network a
net' =
        Network a
net
          { nextCellKey = CellKey (nextInt + 1)
          , cells = M.insert nextInt newCell (cells net)
          }
    in
      (Network a, CellKey) -> Either (Error a) (Network a, CellKey)
forall a b. b -> Either a b
Right (Network a
net', CellKey
nextKey)

-- | Reads the value of a specific cell.

readCell :: CellKey -> Propagator a a
readCell :: forall a. CellKey -> Propagator a a
readCell CellKey
k = Cell a -> a
forall a. Cell a -> a
value (Cell a -> a) -> Propagator a (Cell a) -> Propagator a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CellKey -> Propagator a (Cell a)
forall a. CellKey -> Propagator a (Cell a)
getCell CellKey
k

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

-- changes through the network of connected cells.

writeCell :: CellKey -> a -> Propagator a ()
writeCell :: forall a. CellKey -> a -> Propagator a ()
writeCell CellKey
k a
newValue =
  Propagator a () -> Propagator a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator a () -> Propagator a ())
-> Propagator a () -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ IntSet -> a -> CellKey -> Propagator a ()
forall a. IntSet -> a -> CellKey -> Propagator a ()
push IntSet
S.empty a
newValue CellKey
k

-- | Removes a cell from the network. This also removes all connections related to the cell.

removeCell :: CellKey -> Propagator a ()
removeCell :: forall a. CellKey -> Propagator a ()
removeCell key :: CellKey
key@(CellKey Int
k) = do
  Cell a
theCell <- CellKey -> Propagator a (Cell a)
forall a. CellKey -> Propagator a (Cell a)
getCell CellKey
key
  (Int -> Propagator a ()) -> [Int] -> Propagator a ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
    (ConnectKey -> Propagator a ()
forall a. ConnectKey -> Propagator a ()
disconnect (ConnectKey -> Propagator a ())
-> (Int -> ConnectKey) -> Int -> Propagator a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConnectKey
ConnectKey)
    (IntSet -> [Int]
S.elems (Cell a -> IntSet
forall a. Cell a -> IntSet
subscribers Cell a
theCell) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ IntSet -> [Int]
S.elems (Cell a -> IntSet
forall a. Cell a -> IntSet
incomings Cell a
theCell))
  (IntMap (Cell a) -> IntMap (Cell a)) -> Propagator a ()
forall a. (IntMap (Cell a) -> IntMap (Cell a)) -> Propagator a ()
modifyCells (Int -> IntMap (Cell a) -> IntMap (Cell a)
forall a. Int -> IntMap a -> IntMap a
M.delete Int
k)

-- | If the content of a cell 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.

--

-- This function does not perform any permanent network modifications.

label :: (a -> [b]) -> (b -> a) -> [CellKey] -> Propagator a [[b]]
label :: forall a b.
(a -> [b]) -> (b -> a) -> [CellKey] -> Propagator a [[b]]
label a -> [b]
elems b -> a
reify [CellKey]
keys = [b] -> [CellKey] -> Propagator a [[b]]
solve [] ([CellKey] -> [CellKey]
forall a. [a] -> [a]
reverse [CellKey]
keys)
  where
    solve :: [b] -> [CellKey] -> Propagator a [[b]]
solve [b]
current []     = [[b]] -> Propagator a [[b]]
forall a. a -> Propagator a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[b]
current]
    solve [b]
current (CellKey
k:[CellKey]
ks) =
      (Network a -> Either (Error a) (Network a, [[b]]))
-> Propagator a [[b]]
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, [[b]]))
 -> Propagator a [[b]])
-> (Network a -> Either (Error a) (Network a, [[b]]))
-> Propagator a [[b]]
forall a b. (a -> b) -> a -> b
$ \Network a
net -> do
        (Network a
net',a
a) <- Propagator a a -> Network a -> Either (Error a) (Network a, a)
forall a b.
Propagator a b -> Network a -> Either (Error a) (Network a, b)
runPropagator (CellKey -> Propagator a a
forall a. CellKey -> Propagator a a
readCell CellKey
k) Network a
net
        [[[b]]]
solutions <-
          [b] -> (b -> Either (Error a) [[b]]) -> Either (Error a) [[[b]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (a -> [b]
elems a
a) ((b -> Either (Error a) [[b]]) -> Either (Error a) [[[b]]])
-> (b -> Either (Error a) [[b]]) -> Either (Error a) [[[b]]]
forall a b. (a -> b) -> a -> b
$ \b
b ->
            case Propagator a () -> Network a -> Either (Error a) (Network a, ())
forall a b.
Propagator a b -> Network a -> Either (Error a) (Network a, b)
runPropagator (CellKey -> a -> Propagator a ()
forall a. CellKey -> a -> Propagator a ()
writeCell CellKey
k (b -> a
reify b
b)) Network a
net' of
              Right (Network a
net'',()) ->
                (Network a, [[b]]) -> [[b]]
forall a b. (a, b) -> b
snd ((Network a, [[b]]) -> [[b]])
-> Either (Error a) (Network a, [[b]]) -> Either (Error a) [[b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propagator a [[b]]
-> Network a -> Either (Error a) (Network a, [[b]])
forall a b.
Propagator a b -> Network a -> Either (Error a) (Network a, b)
runPropagator ([b] -> [CellKey] -> Propagator a [[b]]
solve (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
current) [CellKey]
ks) Network a
net''
              Left Error a
_ ->
                [[b]] -> Either (Error a) [[b]]
forall a. a -> Either (Error a) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        (Network a, [[b]]) -> Either (Error a) (Network a, [[b]])
forall a. a -> Either (Error a) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network a
net, [[[b]]] -> [[b]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[b]]]
solutions)

propagator :: ConnectState -> Prop a -> Propagator a ConnectKey
propagator :: forall a. ConnectState -> Prop a -> Propagator a ConnectKey
propagator ConnectState
state Prop a
prop = do
  key :: ConnectKey
key@(ConnectKey Int
k) <- Prop a -> Propagator a ConnectKey
forall a. Prop a -> Propagator a ConnectKey
addPropagator Prop a
prop
  (CellKey -> Propagator a ()) -> [CellKey] -> Propagator a ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Cell a -> Cell a) -> CellKey -> Propagator a ()
forall a. (Cell a -> Cell a) -> CellKey -> Propagator a ()
modifyCell ((Cell a -> Cell a) -> CellKey -> Propagator a ())
-> (Cell a -> Cell a) -> CellKey -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ Int -> Cell a -> Cell a
forall {a}. Int -> Cell a -> Cell a
addSub Int
k) (Prop a -> [CellKey]
forall a. Prop a -> [CellKey]
sources Prop a
prop)
  (CellKey -> Propagator a ()) -> [CellKey] -> Propagator a ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Cell a -> Cell a) -> CellKey -> Propagator a ()
forall a. (Cell a -> Cell a) -> CellKey -> Propagator a ()
modifyCell ((Cell a -> Cell a) -> CellKey -> Propagator a ())
-> (Cell a -> Cell a) -> CellKey -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ Int -> Cell a -> Cell a
forall {a}. Int -> Cell a -> Cell a
addInc Int
k) (Prop a -> [CellKey]
forall a. Prop a -> [CellKey]
targets Prop a
prop)
  case ConnectState
state of
    ConnectState
Live -> IntSet -> ConnectKey -> Propagator a ()
forall a. IntSet -> ConnectKey -> Propagator a ()
fire IntSet
S.empty ConnectKey
key Propagator a ()
-> Propagator a ConnectKey -> Propagator a ConnectKey
forall a b. Propagator a a -> Propagator a b -> Propagator a b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConnectKey -> Propagator a ConnectKey
forall a. a -> Propagator a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectKey
key
    ConnectState
Idle -> ConnectKey -> Propagator a ConnectKey
forall a. a -> Propagator a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectKey
key
  where
    addSub :: Int -> Cell a -> Cell a
addSub Int
k Cell a
c = Cell a
c { subscribers = S.insert k (subscribers c) }
    addInc :: Int -> Cell a -> Cell a
addInc Int
k Cell a
c = Cell a
c { incomings = S.insert k (incomings c) }

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

-- from the source to the target. The returned 'ConnectKey' can be used to

-- remove the connection via 'disconnect'.

connect :: ConnectState -> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ConnectKey
connect :: forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ConnectKey
connect ConnectState
state CellKey
source CellKey
target a -> Maybe a
f =
  ConnectState -> Prop a -> Propagator a ConnectKey
forall a. ConnectState -> Prop a -> Propagator a ConnectKey
propagator ConnectState
state (Prop a -> Propagator a ConnectKey)
-> Prop a -> Propagator a ConnectKey
forall a b. (a -> b) -> a -> b
$ [CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a.
[CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
Prop [CellKey
source] [CellKey
target] ((ConnectKey -> IntSet -> Propagator a ()) -> Prop a)
-> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a b. (a -> b) -> a -> b
$
    \ConnectKey
key IntSet
ws -> do
      a
ins <- CellKey -> Propagator a a
forall a. CellKey -> Propagator a a
readCell CellKey
source
      a
out <- Error a -> Maybe a -> Propagator a a
forall b a. Error b -> Maybe a -> Propagator b a
toPropagator (ConnectKey -> Error a
forall a. ConnectKey -> Error a
NoPropagation ConnectKey
key) (a -> Maybe a
f a
ins)
      IntSet -> a -> CellKey -> Propagator a ()
forall a. IntSet -> a -> CellKey -> Propagator a ()
push IntSet
ws a
out CellKey
target

-- | Same as 'connect', but discards the returned 'ConnectKey'.

connect_ :: ConnectState -> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
connect_ :: forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
connect_ ConnectState
state CellKey
source CellKey
target a -> Maybe a
f =
  Propagator a ConnectKey -> Propagator a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator a ConnectKey -> Propagator a ())
-> Propagator a ConnectKey -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ConnectKey
forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ConnectKey
connect ConnectState
state CellKey
source CellKey
target a -> Maybe a
f

-- | 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'

-- 'Just' 'Just'.

sync :: ConnectState -> CellKey -> CellKey -> Propagator a (ConnectKey, ConnectKey)
sync :: forall a.
ConnectState
-> CellKey -> CellKey -> Propagator a (ConnectKey, ConnectKey)
sync = (a -> Maybe a)
-> (a -> Maybe a)
-> ConnectState
-> CellKey
-> CellKey
-> Propagator a (ConnectKey, ConnectKey)
forall a.
(a -> Maybe a)
-> (a -> Maybe a)
-> ConnectState
-> CellKey
-> CellKey
-> Propagator a (ConnectKey, ConnectKey)
syncWith a -> Maybe a
forall a. a -> Maybe a
Just a -> Maybe a
forall a. a -> Maybe a
Just

-- | Same as 'sync', but discards the returned 'ConnectKey's.

sync_ :: ConnectState -> CellKey -> CellKey -> Propagator a ()
sync_ :: forall a. ConnectState -> CellKey -> CellKey -> Propagator a ()
sync_ ConnectState
state CellKey
c1 CellKey
c2 =
  Propagator a (ConnectKey, ConnectKey) -> Propagator a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator a (ConnectKey, ConnectKey) -> Propagator a ())
-> Propagator a (ConnectKey, ConnectKey) -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKey -> CellKey -> Propagator a (ConnectKey, ConnectKey)
forall a.
ConnectState
-> CellKey -> CellKey -> Propagator a (ConnectKey, ConnectKey)
sync ConnectState
state CellKey
c1 CellKey
c2

-- | 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@.

syncWith
  :: (a -> Maybe a)
  -> (a -> Maybe a)
  -> ConnectState
  -> CellKey
  -> CellKey
  -> Propagator a (ConnectKey, ConnectKey)
syncWith :: forall a.
(a -> Maybe a)
-> (a -> Maybe a)
-> ConnectState
-> CellKey
-> CellKey
-> Propagator a (ConnectKey, ConnectKey)
syncWith a -> Maybe a
f a -> Maybe a
g ConnectState
state CellKey
c1 CellKey
c2 = do
  ConnectKey
key1 <- ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ConnectKey
forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ConnectKey
connect ConnectState
state CellKey
c1 CellKey
c2 a -> Maybe a
f
  ConnectKey
key2 <- ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ConnectKey
forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ConnectKey
connect ConnectState
state CellKey
c2 CellKey
c1 a -> Maybe a
g
  (ConnectKey, ConnectKey) -> Propagator a (ConnectKey, ConnectKey)
forall a. a -> Propagator a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectKey
key1, ConnectKey
key2)

-- | Same as 'syncWith', but discards the returned 'ConnectKey's.

syncWith_
  :: (a -> Maybe a)
  -> (a -> Maybe a)
  -> ConnectState
  -> CellKey
  -> CellKey
  -> Propagator a ()
syncWith_ :: forall a.
(a -> Maybe a)
-> (a -> Maybe a)
-> ConnectState
-> CellKey
-> CellKey
-> Propagator a ()
syncWith_ a -> Maybe a
f a -> Maybe a
g ConnectState
state CellKey
c1 CellKey
c2 =
  Propagator a (ConnectKey, ConnectKey) -> Propagator a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator a (ConnectKey, ConnectKey) -> Propagator a ())
-> Propagator a (ConnectKey, ConnectKey) -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a)
-> (a -> Maybe a)
-> ConnectState
-> CellKey
-> CellKey
-> Propagator a (ConnectKey, ConnectKey)
forall a.
(a -> Maybe a)
-> (a -> Maybe a)
-> ConnectState
-> CellKey
-> CellKey
-> Propagator a (ConnectKey, ConnectKey)
syncWith a -> Maybe a
f a -> Maybe a
g ConnectState
state CellKey
c1 CellKey
c2

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

-- from the sources to the target. The returned 'ConnectKey' can be used to

-- remove the connection via 'disconnect'.

combine :: ConnectState -> CellKey -> CellKey -> CellKey -> (a -> a -> Maybe a) -> Propagator a ConnectKey
combine :: forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ConnectKey
combine ConnectState
state CellKey
source1 CellKey
source2 CellKey
target a -> a -> Maybe a
f =
  ConnectState -> Prop a -> Propagator a ConnectKey
forall a. ConnectState -> Prop a -> Propagator a ConnectKey
propagator ConnectState
state (Prop a -> Propagator a ConnectKey)
-> Prop a -> Propagator a ConnectKey
forall a b. (a -> b) -> a -> b
$ [CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a.
[CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
Prop [CellKey
source1,CellKey
source2] [CellKey
target] ((ConnectKey -> IntSet -> Propagator a ()) -> Prop a)
-> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a b. (a -> b) -> a -> b
$
    \ConnectKey
key IntSet
ws -> do
      a
in1 <- CellKey -> Propagator a a
forall a. CellKey -> Propagator a a
readCell CellKey
source1
      a
in2 <- CellKey -> Propagator a a
forall a. CellKey -> Propagator a a
readCell CellKey
source2
      a
out <- Error a -> Maybe a -> Propagator a a
forall b a. Error b -> Maybe a -> Propagator b a
toPropagator (ConnectKey -> Error a
forall a. ConnectKey -> Error a
NoPropagation ConnectKey
key) (a -> a -> Maybe a
f a
in1 a
in2)
      IntSet -> a -> CellKey -> Propagator a ()
forall a. IntSet -> a -> CellKey -> Propagator a ()
push IntSet
ws a
out CellKey
target

-- | Same as 'combine', but discards the returned 'ConnectKey'.

combine_ :: ConnectState -> CellKey -> CellKey -> CellKey -> (a -> a -> Maybe a) -> Propagator a ()
combine_ :: forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
source1 CellKey
source2 CellKey
target a -> a -> Maybe a
f =
  Propagator a ConnectKey -> Propagator a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator a ConnectKey -> Propagator a ())
-> Propagator a ConnectKey -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ConnectKey
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ConnectKey
combine ConnectState
state CellKey
source1 CellKey
source2 CellKey
target a -> a -> Maybe a
f

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

-- from the sources to the target. The returned 'ConnectKey' can be used to

-- remove the connection via 'disconnect'.

combineMany :: ConnectState -> [CellKey] -> CellKey -> ([a] -> Maybe a) -> Propagator a ConnectKey
combineMany :: forall a.
ConnectState
-> [CellKey]
-> CellKey
-> ([a] -> Maybe a)
-> Propagator a ConnectKey
combineMany ConnectState
state [CellKey]
sources CellKey
target [a] -> Maybe a
f =
  ConnectState -> Prop a -> Propagator a ConnectKey
forall a. ConnectState -> Prop a -> Propagator a ConnectKey
propagator ConnectState
state (Prop a -> Propagator a ConnectKey)
-> Prop a -> Propagator a ConnectKey
forall a b. (a -> b) -> a -> b
$ [CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a.
[CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
Prop [CellKey]
sources [CellKey
target] ((ConnectKey -> IntSet -> Propagator a ()) -> Prop a)
-> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a b. (a -> b) -> a -> b
$
    \ConnectKey
key IntSet
ws -> do
      [a]
ins <- (CellKey -> Propagator a a) -> [CellKey] -> Propagator a [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse CellKey -> Propagator a a
forall a. CellKey -> Propagator a a
readCell [CellKey]
sources
      a
out <- Error a -> Maybe a -> Propagator a a
forall b a. Error b -> Maybe a -> Propagator b a
toPropagator (ConnectKey -> Error a
forall a. ConnectKey -> Error a
NoPropagation ConnectKey
key) ([a] -> Maybe a
f [a]
ins)
      IntSet -> a -> CellKey -> Propagator a ()
forall a. IntSet -> a -> CellKey -> Propagator a ()
push IntSet
ws a
out CellKey
target

-- | Same as 'combineMany', but discards the returned 'ConnectKey'.

combineMany_ :: ConnectState -> [CellKey] -> CellKey -> ([a] -> Maybe a) -> Propagator a ()
combineMany_ :: forall a.
ConnectState
-> [CellKey] -> CellKey -> ([a] -> Maybe a) -> Propagator a ()
combineMany_ ConnectState
state [CellKey]
sources CellKey
target [a] -> Maybe a
f =
  Propagator a ConnectKey -> Propagator a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator a ConnectKey -> Propagator a ())
-> Propagator a ConnectKey -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> [CellKey]
-> CellKey
-> ([a] -> Maybe a)
-> Propagator a ConnectKey
forall a.
ConnectState
-> [CellKey]
-> CellKey
-> ([a] -> Maybe a)
-> Propagator a ConnectKey
combineMany ConnectState
state [CellKey]
sources CellKey
target [a] -> Maybe a
f

-- | Connects a source cells to several target cells in order to propagate changes

-- from the source to the targets. The returned 'ConnectKey' can be used to

-- remove the connection via 'disconnect'.

distribute :: ConnectState -> CellKey -> [CellKey] -> (a -> Maybe a) -> Propagator a ConnectKey
distribute :: forall a.
ConnectState
-> CellKey
-> [CellKey]
-> (a -> Maybe a)
-> Propagator a ConnectKey
distribute ConnectState
state CellKey
source [CellKey]
targets a -> Maybe a
f =
  ConnectState -> Prop a -> Propagator a ConnectKey
forall a. ConnectState -> Prop a -> Propagator a ConnectKey
propagator ConnectState
state (Prop a -> Propagator a ConnectKey)
-> Prop a -> Propagator a ConnectKey
forall a b. (a -> b) -> a -> b
$ [CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a.
[CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
Prop [CellKey
source] [CellKey]
targets ((ConnectKey -> IntSet -> Propagator a ()) -> Prop a)
-> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a b. (a -> b) -> a -> b
$
    \ConnectKey
key IntSet
ws -> do
      a
ins <- CellKey -> Propagator a a
forall a. CellKey -> Propagator a a
readCell CellKey
source
      a
out <- Error a -> Maybe a -> Propagator a a
forall b a. Error b -> Maybe a -> Propagator b a
toPropagator (ConnectKey -> Error a
forall a. ConnectKey -> Error a
NoPropagation ConnectKey
key) (a -> Maybe a
f a
ins)
      (CellKey -> Propagator a ()) -> [CellKey] -> Propagator a ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IntSet -> a -> CellKey -> Propagator a ()
forall a. IntSet -> a -> CellKey -> Propagator a ()
push IntSet
ws a
out) [CellKey]
targets

-- | Same as 'distribute', but discards the returned 'ConnectKey'.

distribute_ :: ConnectState -> CellKey -> [CellKey] -> (a -> Maybe a) -> Propagator a ()
distribute_ :: forall a.
ConnectState
-> CellKey -> [CellKey] -> (a -> Maybe a) -> Propagator a ()
distribute_ ConnectState
state CellKey
source [CellKey]
targets a -> Maybe a
f =
  Propagator a ConnectKey -> Propagator a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator a ConnectKey -> Propagator a ())
-> Propagator a ConnectKey -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKey
-> [CellKey]
-> (a -> Maybe a)
-> Propagator a ConnectKey
forall a.
ConnectState
-> CellKey
-> [CellKey]
-> (a -> Maybe a)
-> Propagator a ConnectKey
distribute ConnectState
state CellKey
source [CellKey]
targets a -> Maybe a
f

-- | Connects several source cells to several target cells in order to propagate changes

-- from the sources to the targets. The returned 'ConnectKey' can be used to

-- remove the connection via 'disconnect'.

manyToMany :: ConnectState -> [CellKey] -> [CellKey] -> ([a] -> Maybe a) -> Propagator a ConnectKey
manyToMany :: forall a.
ConnectState
-> [CellKey]
-> [CellKey]
-> ([a] -> Maybe a)
-> Propagator a ConnectKey
manyToMany ConnectState
state [CellKey]
sources [CellKey]
targets [a] -> Maybe a
f =
  ConnectState -> Prop a -> Propagator a ConnectKey
forall a. ConnectState -> Prop a -> Propagator a ConnectKey
propagator ConnectState
state (Prop a -> Propagator a ConnectKey)
-> Prop a -> Propagator a ConnectKey
forall a b. (a -> b) -> a -> b
$ [CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a.
[CellKey]
-> [CellKey] -> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
Prop [CellKey]
sources [CellKey]
targets ((ConnectKey -> IntSet -> Propagator a ()) -> Prop a)
-> (ConnectKey -> IntSet -> Propagator a ()) -> Prop a
forall a b. (a -> b) -> a -> b
$
    \ConnectKey
key IntSet
ws -> do
      [a]
ins <- (CellKey -> Propagator a a) -> [CellKey] -> Propagator a [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse CellKey -> Propagator a a
forall a. CellKey -> Propagator a a
readCell [CellKey]
sources
      a
out <- Error a -> Maybe a -> Propagator a a
forall b a. Error b -> Maybe a -> Propagator b a
toPropagator (ConnectKey -> Error a
forall a. ConnectKey -> Error a
NoPropagation ConnectKey
key) ([a] -> Maybe a
f [a]
ins)
      (CellKey -> Propagator a ()) -> [CellKey] -> Propagator a ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IntSet -> a -> CellKey -> Propagator a ()
forall a. IntSet -> a -> CellKey -> Propagator a ()
push IntSet
ws a
out) [CellKey]
targets

-- | Same as 'manyToMany', but discards the returned 'ConnectKey'.

manyToMany_ :: ConnectState -> [CellKey] -> [CellKey] -> ([a] -> Maybe a) -> Propagator a ()
manyToMany_ :: forall a.
ConnectState
-> [CellKey] -> [CellKey] -> ([a] -> Maybe a) -> Propagator a ()
manyToMany_ ConnectState
state [CellKey]
sources [CellKey]
targets [a] -> Maybe a
f =
  Propagator a ConnectKey -> Propagator a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator a ConnectKey -> Propagator a ())
-> Propagator a ConnectKey -> Propagator a ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> [CellKey]
-> [CellKey]
-> ([a] -> Maybe a)
-> Propagator a ConnectKey
forall a.
ConnectState
-> [CellKey]
-> [CellKey]
-> ([a] -> Maybe a)
-> Propagator a ConnectKey
manyToMany ConnectState
state [CellKey]
sources [CellKey]
targets [a] -> Maybe a
f

-- | Removes a connection from the network.

disconnect :: ConnectKey -> Propagator a ()
disconnect :: forall a. ConnectKey -> Propagator a ()
disconnect key :: ConnectKey
key@(ConnectKey Int
k) = do
  Prop a
prop <- ConnectKey -> Propagator a (Prop a)
forall a. ConnectKey -> Propagator a (Prop a)
extractPropagator ConnectKey
key
  (CellKey -> Propagator a ()) -> [CellKey] -> Propagator a ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Cell a -> Cell a) -> CellKey -> Propagator a ()
forall a. (Cell a -> Cell a) -> CellKey -> Propagator a ()
modifyCell Cell a -> Cell a
forall {a}. Cell a -> Cell a
removeSub) (Prop a -> [CellKey]
forall a. Prop a -> [CellKey]
sources Prop a
prop)
  (CellKey -> Propagator a ()) -> [CellKey] -> Propagator a ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Cell a -> Cell a) -> CellKey -> Propagator a ()
forall a. (Cell a -> Cell a) -> CellKey -> Propagator a ()
modifyCell Cell a -> Cell a
forall {a}. Cell a -> Cell a
removeInc) (Prop a -> [CellKey]
forall a. Prop a -> [CellKey]
targets Prop a
prop)
    where
      removeSub :: Cell a -> Cell a
removeSub Cell a
c =
        Cell a
c { subscribers = S.delete k (subscribers c) }
      removeInc :: Cell a -> Cell a
removeInc Cell a
c =
        Cell a
c { incomings = S.delete k (incomings c) }

fire :: S.IntSet -> ConnectKey -> Propagator a ()
fire :: forall a. IntSet -> ConnectKey -> Propagator a ()
fire IntSet
writes ConnectKey
k = do
  Prop a
prop <- ConnectKey -> Propagator a (Prop a)
forall a. ConnectKey -> Propagator a (Prop a)
getPropagator ConnectKey
k
  Prop a -> ConnectKey -> IntSet -> Propagator a ()
forall a. Prop a -> ConnectKey -> IntSet -> Propagator a ()
action Prop a
prop ConnectKey
k IntSet
writes

push :: S.IntSet -> a -> CellKey -> Propagator a ()
push :: forall a. IntSet -> a -> CellKey -> Propagator a ()
push IntSet
writes a
newValue ck :: CellKey
ck@(CellKey Int
k) =
  (Network a -> Either (Error a) (Network a, ())) -> Propagator a ()
forall a b.
(Network a -> Either (Error a) (Network a, b)) -> Propagator a b
Propagator ((Network a -> Either (Error a) (Network a, ()))
 -> Propagator a ())
-> (Network a -> Either (Error a) (Network a, ()))
-> Propagator a ()
forall a b. (a -> b) -> a -> b
$ \Network a
net -> do
    (IntSet
subs, IntMap (Cell a)
newCells) <- Compose (Either (Error a)) ((,) IntSet) (IntMap (Cell a))
-> Either (Error a) (IntSet, IntMap (Cell a))
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (Either (Error a)) ((,) IntSet) (IntMap (Cell a))
 -> Either (Error a) (IntSet, IntMap (Cell a)))
-> Compose (Either (Error a)) ((,) IntSet) (IntMap (Cell a))
-> Either (Error a) (IntSet, IntMap (Cell a))
forall a b. (a -> b) -> a -> b
$ (Maybe (Cell a)
 -> Compose (Either (Error a)) ((,) IntSet) (Maybe (Cell a)))
-> Int
-> IntMap (Cell a)
-> Compose (Either (Error a)) ((,) IntSet) (IntMap (Cell a))
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Int -> IntMap a -> f (IntMap a)
M.alterF Maybe (Cell a)
-> Compose (Either (Error a)) ((,) IntSet) (Maybe (Cell a))
change Int
k (Network a -> IntMap (Cell a)
forall a. Network a -> IntMap (Cell a)
cells Network a
net)
    (Propagator a () -> Network a -> Either (Error a) (Network a, ()))
-> Network a -> Propagator a () -> Either (Error a) (Network a, ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip Propagator a () -> Network a -> Either (Error a) (Network a, ())
forall a b.
Propagator a b -> Network a -> Either (Error a) (Network a, b)
runPropagator Network a
net { cells = newCells } (Propagator a () -> Either (Error a) (Network a, ()))
-> Propagator a () -> Either (Error a) (Network a, ())
forall a b. (a -> b) -> a -> b
$
      (Int -> Propagator a ()) -> [Int] -> Propagator a ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
        (IntSet -> ConnectKey -> Propagator a ()
forall a. IntSet -> ConnectKey -> Propagator a ()
fire (Int -> IntSet -> IntSet
S.insert Int
k IntSet
writes) (ConnectKey -> Propagator a ())
-> (Int -> ConnectKey) -> Int -> Propagator a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConnectKey
ConnectKey)
        (IntSet -> [Int]
S.elems IntSet
subs)
  where
    change :: Maybe (Cell a)
-> Compose (Either (Error a)) ((,) IntSet) (Maybe (Cell a))
change Maybe (Cell a)
maybeCell =
      Either (Error a) (IntSet, Maybe (Cell a))
-> Compose (Either (Error a)) ((,) IntSet) (Maybe (Cell a))
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either (Error a) (IntSet, Maybe (Cell a))
 -> Compose (Either (Error a)) ((,) IntSet) (Maybe (Cell a)))
-> Either (Error a) (IntSet, Maybe (Cell a))
-> Compose (Either (Error a)) ((,) IntSet) (Maybe (Cell a))
forall a b. (a -> b) -> a -> b
$
        case Maybe (Cell a)
maybeCell of
          Maybe (Cell a)
Nothing -> Error a -> Either (Error a) (IntSet, Maybe (Cell a))
forall a b. a -> Either a b
Left (CellKey -> Error a
forall a. CellKey -> Error a
InvalidCell CellKey
ck)
          Just c :: Cell a
c@(Cell {a
value :: forall a. Cell a -> a
value :: a
value}) ->
            case Cell a -> a -> a -> Change a
forall a. Cell a -> a -> a -> Change a
update Cell a
c a
value a
newValue of
              Changed a
new ->
                if Int -> IntSet -> Bool
S.member Int
k IntSet
writes then
                  Error a -> Either (Error a) (IntSet, Maybe (Cell a))
forall a b. a -> Either a b
Left (CellKey -> Error a
forall a. CellKey -> Error a
Cycle CellKey
ck)
                else
                  (IntSet, Maybe (Cell a))
-> Either (Error a) (IntSet, Maybe (Cell a))
forall a b. b -> Either a b
Right (Cell a -> IntSet
forall a. Cell a -> IntSet
subscribers Cell a
c, Cell a -> Maybe (Cell a)
forall a. a -> Maybe a
Just Cell a
c { value = new })
              Unchanged a
_ -> 
                (IntSet, Maybe (Cell a))
-> Either (Error a) (IntSet, Maybe (Cell a))
forall a b. b -> Either a b
Right (IntSet
S.empty, Cell a -> Maybe (Cell a)
forall a. a -> Maybe a
Just Cell a
c)
              Change a
Incompatible ->
                Error a -> Either (Error a) (IntSet, Maybe (Cell a))
forall a b. a -> Either a b
Left (CellKey -> a -> a -> Error a
forall a. CellKey -> a -> a -> Error a
Conflict CellKey
ck a
value a
newValue)

-- | Represents possible errors that may occur when modifying or using a network.

data Error a
  = InvalidCell CellKey
  -- ^ The specified cell could not be found.

  | InvalidConnect ConnectKey
  -- ^ The specified connection could not be found.

  | NoPropagation ConnectKey
  -- ^ The specified did not produce a value.

  | Conflict CellKey a a
  -- ^ The old value of the specified cell is incompatible with a new value propagated to it.

  | Cycle CellKey
  -- ^ The specified cell propagated a value to itself (directly or indirectly), leading to a cycle.

  deriving (Error a -> Error a -> Bool
(Error a -> Error a -> Bool)
-> (Error a -> Error a -> Bool) -> Eq (Error a)
forall a. Eq a => Error a -> Error a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Error a -> Error a -> Bool
== :: Error a -> Error a -> Bool
$c/= :: forall a. Eq a => Error a -> Error a -> Bool
/= :: Error a -> Error a -> Bool
Eq, Eq (Error a)
Eq (Error a) =>
(Error a -> Error a -> Ordering)
-> (Error a -> Error a -> Bool)
-> (Error a -> Error a -> Bool)
-> (Error a -> Error a -> Bool)
-> (Error a -> Error a -> Bool)
-> (Error a -> Error a -> Error a)
-> (Error a -> Error a -> Error a)
-> Ord (Error a)
Error a -> Error a -> Bool
Error a -> Error a -> Ordering
Error a -> Error a -> Error a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Error a)
forall a. Ord a => Error a -> Error a -> Bool
forall a. Ord a => Error a -> Error a -> Ordering
forall a. Ord a => Error a -> Error a -> Error a
$ccompare :: forall a. Ord a => Error a -> Error a -> Ordering
compare :: Error a -> Error a -> Ordering
$c< :: forall a. Ord a => Error a -> Error a -> Bool
< :: Error a -> Error a -> Bool
$c<= :: forall a. Ord a => Error a -> Error a -> Bool
<= :: Error a -> Error a -> Bool
$c> :: forall a. Ord a => Error a -> Error a -> Bool
> :: Error a -> Error a -> Bool
$c>= :: forall a. Ord a => Error a -> Error a -> Bool
>= :: Error a -> Error a -> Bool
$cmax :: forall a. Ord a => Error a -> Error a -> Error a
max :: Error a -> Error a -> Error a
$cmin :: forall a. Ord a => Error a -> Error a -> Error a
min :: Error a -> Error a -> Error a
Ord, Int -> Error a -> ShowS
[Error a] -> ShowS
Error a -> String
(Int -> Error a -> ShowS)
-> (Error a -> String) -> ([Error a] -> ShowS) -> Show (Error a)
forall a. Show a => Int -> Error a -> ShowS
forall a. Show a => [Error a] -> ShowS
forall a. Show a => Error a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Error a -> ShowS
showsPrec :: Int -> Error a -> ShowS
$cshow :: forall a. Show a => Error a -> String
show :: Error a -> String
$cshowList :: forall a. Show a => [Error a] -> ShowS
showList :: [Error a] -> ShowS
Show)

toError :: Error b -> Maybe a -> Either (Error b) a
toError :: forall b a. Error b -> Maybe a -> Either (Error b) a
toError Error b
_ (Just a
a) = a -> Either (Error b) a
forall a b. b -> Either a b
Right a
a
toError Error b
e Maybe a
Nothing  = Error b -> Either (Error b) a
forall a b. a -> Either a b
Left Error b
e

toPropagator :: Error b -> Maybe a -> Propagator b a
toPropagator :: forall b a. Error b -> Maybe a -> Propagator b a
toPropagator Error b
e Maybe a
m =
  case Maybe a
m of
    Just a
a  -> a -> Propagator b a
forall a. a -> Propagator b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Maybe a
Nothing -> Error b -> Propagator b a
forall b a. Error b -> Propagator b a
failWith Error b
e

-- | @plus s 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 => ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
plus :: forall a.
Num a =>
ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
plus ConnectState
state CellKey
left CellKey
right CellKey
result = do
  ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
left CellKey
right CellKey
result (\a
lv a
rv -> a -> Maybe a
forall a. a -> Maybe a
Just (a
lv a -> a -> a
forall a. Num a => a -> a -> a
+ a
rv))
  ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
left CellKey
result CellKey
right (\a
lv a
r  -> a -> Maybe a
forall a. a -> Maybe a
Just (a
r a -> a -> a
forall a. Num a => a -> a -> a
- a
lv))
  ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
right CellKey
result CellKey
left (\a
rv a
r  -> a -> Maybe a
forall a. a -> Maybe a
Just (a
r a -> a -> a
forall a. Num a => a -> a -> a
- a
rv))

-- | @minus s 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 => ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
minus :: forall a.
Num a =>
ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
minus ConnectState
state CellKey
left CellKey
right CellKey
result = do
  ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
left CellKey
right CellKey
result (\a
lv a
rv -> a -> Maybe a
forall a. a -> Maybe a
Just (a
lv a -> a -> a
forall a. Num a => a -> a -> a
- a
rv))
  ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
left CellKey
result CellKey
right (\a
lv a
r  -> a -> Maybe a
forall a. a -> Maybe a
Just (a
lv a -> a -> a
forall a. Num a => a -> a -> a
- a
r))
  ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
right CellKey
result CellKey
left (\a
rv a
r  -> a -> Maybe a
forall a. a -> Maybe a
Just (a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a
rv))

-- | @times s 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 => ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
times :: forall a.
Num a =>
ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
times ConnectState
state CellKey
left CellKey
right CellKey
result =
  ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
left CellKey
right CellKey
result (\a
lv a
rv -> a -> Maybe a
forall a. a -> Maybe a
Just (a
lv a -> a -> a
forall a. Num a => a -> a -> a
* a
rv))

-- | @timesWith divOp s 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) -> ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
timesWith :: forall a.
Num a =>
(a -> a -> a)
-> ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
timesWith a -> a -> a
divOp ConnectState
state CellKey
left CellKey
right CellKey
result = do
  ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
forall a.
Num a =>
ConnectState -> CellKey -> CellKey -> CellKey -> Propagator a ()
times ConnectState
state CellKey
left CellKey
right CellKey
result
  ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
left CellKey
result CellKey
right (\a
lv a
r -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
divOp a
r a
lv))
  ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
forall a.
ConnectState
-> CellKey
-> CellKey
-> CellKey
-> (a -> a -> Maybe a)
-> Propagator a ()
combine_ ConnectState
state CellKey
right CellKey
result CellKey
left (\a
rv a
r -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
divOp a
r a
rv))

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

--

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

abs :: Num a => ConnectState -> CellKey -> CellKey -> Propagator a ()
abs :: forall a.
Num a =>
ConnectState -> CellKey -> CellKey -> Propagator a ()
abs ConnectState
state CellKey
left CellKey
right =
  ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
connect_ ConnectState
state CellKey
left CellKey
right (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.abs)

-- | @absWith inv s 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) -> ConnectState -> CellKey -> CellKey -> Propagator a ()
absWith :: forall a.
Num a =>
(a -> a) -> ConnectState -> CellKey -> CellKey -> Propagator a ()
absWith a -> a
inv ConnectState
state CellKey
left CellKey
right = do
  ConnectState -> CellKey -> CellKey -> Propagator a ()
forall a.
Num a =>
ConnectState -> CellKey -> CellKey -> Propagator a ()
abs ConnectState
state CellKey
left CellKey
right
  ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
connect_ ConnectState
state CellKey
right CellKey
left (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
inv)

-- | @negate s 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 => ConnectState -> CellKey -> CellKey -> Propagator a ()
negate :: forall a.
Num a =>
ConnectState -> CellKey -> CellKey -> Propagator a ()
negate ConnectState
state CellKey
left CellKey
right = do
  ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
connect_ ConnectState
state CellKey
left CellKey
right (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.negate)
  ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
connect_ ConnectState
state CellKey
right CellKey
left (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.negate)

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

--

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

signum :: Num a => ConnectState -> CellKey -> CellKey -> Propagator a ()
signum :: forall a.
Num a =>
ConnectState -> CellKey -> CellKey -> Propagator a ()
signum ConnectState
state CellKey
left CellKey
right =
  ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
connect_ ConnectState
state CellKey
left CellKey
right (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
Prelude.signum)

-- | @signumWith inv s 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) -> ConnectState -> CellKey -> CellKey -> Propagator a ()
signumWith :: forall a.
Num a =>
(a -> a) -> ConnectState -> CellKey -> CellKey -> Propagator a ()
signumWith a -> a
inv ConnectState
state CellKey
left CellKey
right = do
  ConnectState -> CellKey -> CellKey -> Propagator a ()
forall a.
Num a =>
ConnectState -> CellKey -> CellKey -> Propagator a ()
signum ConnectState
state CellKey
left CellKey
right
  ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
forall a.
ConnectState
-> CellKey -> CellKey -> (a -> Maybe a) -> Propagator a ()
connect_ ConnectState
state CellKey
right CellKey
left (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
inv)