{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module Data.Propagator.Hetero
(
Network
, empty
, Error(..)
, Propagator
, runPropagator
, CellKey(..)
, CellKeys(..)
, CellValues(..)
, Change(..)
, cell
, readCell
, writeCell
, removeCell
, label
, ConnectKey(..)
, ConnectState(..)
, connect
, connect_
, sync
, sync_
, syncWith
, syncWith_
, combine
, combine_
, combineMany
, combineMany_
, distribute
, distribute_
, manyToMany
, manyToMany_
, disconnect
, plus
, minus
, times
, timesWith
, abs
, absWith
, negate
, signum
, signumWith
) where
import Control.Monad (forM, void)
import Data.Foldable (traverse_)
import Data.Functor.Compose (Compose(..))
import Data.Kind (Type)
import Unsafe.Coerce (unsafeCoerce)
import Prelude hiding (abs, negate, signum)
import Prelude qualified as Prelude
import Data.IntMap.Strict qualified as M
import Data.IntSet qualified as S
import Data.Propagator.Change (Change(..))
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
}
newtype CellKey (a :: Type) = CellKey { forall a. CellKey a -> Int
rawCellKey :: Int }
deriving (CellKey a -> CellKey a -> Bool
(CellKey a -> CellKey a -> Bool)
-> (CellKey a -> CellKey a -> Bool) -> Eq (CellKey a)
forall a. CellKey a -> CellKey a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. CellKey a -> CellKey a -> Bool
== :: CellKey a -> CellKey a -> Bool
$c/= :: forall a. CellKey a -> CellKey a -> Bool
/= :: CellKey a -> CellKey a -> Bool
Eq, Eq (CellKey a)
Eq (CellKey a) =>
(CellKey a -> CellKey a -> Ordering)
-> (CellKey a -> CellKey a -> Bool)
-> (CellKey a -> CellKey a -> Bool)
-> (CellKey a -> CellKey a -> Bool)
-> (CellKey a -> CellKey a -> Bool)
-> (CellKey a -> CellKey a -> CellKey a)
-> (CellKey a -> CellKey a -> CellKey a)
-> Ord (CellKey a)
CellKey a -> CellKey a -> Bool
CellKey a -> CellKey a -> Ordering
CellKey a -> CellKey a -> CellKey a
forall a. Eq (CellKey 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. CellKey a -> CellKey a -> Bool
forall a. CellKey a -> CellKey a -> Ordering
forall a. CellKey a -> CellKey a -> CellKey a
$ccompare :: forall a. CellKey a -> CellKey a -> Ordering
compare :: CellKey a -> CellKey a -> Ordering
$c< :: forall a. CellKey a -> CellKey a -> Bool
< :: CellKey a -> CellKey a -> Bool
$c<= :: forall a. CellKey a -> CellKey a -> Bool
<= :: CellKey a -> CellKey a -> Bool
$c> :: forall a. CellKey a -> CellKey a -> Bool
> :: CellKey a -> CellKey a -> Bool
$c>= :: forall a. CellKey a -> CellKey a -> Bool
>= :: CellKey a -> CellKey a -> Bool
$cmax :: forall a. CellKey a -> CellKey a -> CellKey a
max :: CellKey a -> CellKey a -> CellKey a
$cmin :: forall a. CellKey a -> CellKey a -> CellKey a
min :: CellKey a -> CellKey a -> CellKey a
Ord, Int -> CellKey a -> ShowS
[CellKey a] -> ShowS
CellKey a -> String
(Int -> CellKey a -> ShowS)
-> (CellKey a -> String)
-> ([CellKey a] -> ShowS)
-> Show (CellKey a)
forall a. Int -> CellKey a -> ShowS
forall a. [CellKey a] -> ShowS
forall a. CellKey a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> CellKey a -> ShowS
showsPrec :: Int -> CellKey a -> ShowS
$cshow :: forall a. CellKey a -> String
show :: CellKey a -> String
$cshowList :: forall a. [CellKey a] -> ShowS
showList :: [CellKey a] -> ShowS
Show)
data CellKeys ts where
KNil :: CellKeys '[]
KCons :: CellKey a -> CellKeys ts -> CellKeys (a ': ts)
infixr 3 `KCons`
data CellValues ts where
VNil :: CellValues '[]
VCons :: a -> CellValues ts -> CellValues (a ': ts)
infixr 3 `VCons`
data Some t = forall a. Some (t a)
data Prop = Prop
{ Prop -> [Some CellKey]
sources :: ![Some CellKey]
, Prop -> [Some CellKey]
targets :: ![Some CellKey]
, Prop -> ConnectKey -> Propagator ()
action :: !(ConnectKey -> Propagator ())
}
newtype ConnectKey = ConnectKey { ConnectKey -> Int
rawConnectKey :: 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)
data Network = Network
{ :: !Int
, :: !Int
, Network -> IntMap (Some Cell)
cells :: !(M.IntMap (Some Cell))
, Network -> IntMap Prop
propagators :: !(M.IntMap Prop)
}
newtype Propagator a =
Propagator
{ forall a. Propagator a -> Network -> Either Error (Network, a)
runPropagator :: Network -> Either Error (Network, a)
}
deriving (forall a b. (a -> b) -> Propagator a -> Propagator b)
-> (forall a b. a -> Propagator b -> Propagator a)
-> Functor Propagator
forall a b. a -> Propagator b -> Propagator a
forall a b. (a -> b) -> Propagator a -> Propagator 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 b. (a -> b) -> Propagator a -> Propagator b
fmap :: forall a b. (a -> b) -> Propagator a -> Propagator b
$c<$ :: forall a b. a -> Propagator b -> Propagator a
<$ :: forall a b. a -> Propagator b -> Propagator a
Functor
instance Applicative Propagator where
pure :: forall a. a -> Propagator a
pure a
a =
(Network -> Either Error (Network, a)) -> Propagator a
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator (\Network
net -> (Network, a) -> Either Error (Network, a)
forall a b. b -> Either a b
Right (Network
net, a
a))
Propagator (a -> b)
pf <*> :: forall a b. Propagator (a -> b) -> Propagator a -> Propagator b
<*> Propagator a
pa =
(Network -> Either Error (Network, b)) -> Propagator b
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, b)) -> Propagator b)
-> (Network -> Either Error (Network, b)) -> Propagator b
forall a b. (a -> b) -> a -> b
$ \Network
net -> do
(Network
net',a -> b
f) <- Propagator (a -> b) -> Network -> Either Error (Network, a -> b)
forall a. Propagator a -> Network -> Either Error (Network, a)
runPropagator Propagator (a -> b)
pf Network
net
(Network
net'',a
a) <- Propagator a -> Network -> Either Error (Network, a)
forall a. Propagator a -> Network -> Either Error (Network, a)
runPropagator Propagator a
pa Network
net'
(Network, b) -> Either Error (Network, b)
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network
net'', a -> b
f a
a)
instance Monad Propagator where
Propagator Network -> Either Error (Network, a)
f >>= :: forall a b. Propagator a -> (a -> Propagator b) -> Propagator b
>>= a -> Propagator b
g =
(Network -> Either Error (Network, b)) -> Propagator b
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, b)) -> Propagator b)
-> (Network -> Either Error (Network, b)) -> Propagator b
forall a b. (a -> b) -> a -> b
$ \Network
net -> do
(Network
net',a
a) <- Network -> Either Error (Network, a)
f Network
net
Propagator b -> Network -> Either Error (Network, b)
forall a. Propagator a -> Network -> Either Error (Network, a)
runPropagator (a -> Propagator b
g a
a) Network
net'
data ConnectState
= Live
| Idle
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)
readValues :: CellKeys ts -> Propagator (CellValues ts)
readValues :: forall (ts :: [*]). CellKeys ts -> Propagator (CellValues ts)
readValues CellKeys ts
KNil = CellValues ts -> Propagator (CellValues ts)
forall a. a -> Propagator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CellValues ts
CellValues '[]
VNil
readValues (KCons CellKey a
key CellKeys ts
ts) = do
a
value <- CellKey a -> Propagator a
forall a. CellKey a -> Propagator a
readCell CellKey a
key
CellValues ts
other <- CellKeys ts -> Propagator (CellValues ts)
forall (ts :: [*]). CellKeys ts -> Propagator (CellValues ts)
readValues CellKeys ts
ts
CellValues ts -> Propagator (CellValues ts)
forall a. a -> Propagator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
value a -> CellValues ts -> CellValues (a : ts)
forall a (ts :: [*]). a -> CellValues ts -> CellValues (a : ts)
`VCons` CellValues ts
other)
someKeys :: CellKeys ts -> [Some CellKey]
someKeys :: forall (ts :: [*]). CellKeys ts -> [Some CellKey]
someKeys CellKeys ts
KNil = []
someKeys (KCons CellKey a
key CellKeys ts
ts) = CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey a
key Some CellKey -> [Some CellKey] -> [Some CellKey]
forall a. a -> [a] -> [a]
: CellKeys ts -> [Some CellKey]
forall (ts :: [*]). CellKeys ts -> [Some CellKey]
someKeys CellKeys ts
ts
failWith :: Error -> Propagator a
failWith :: forall a. Error -> Propagator a
failWith Error
e = (Network -> Either Error (Network, a)) -> Propagator a
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, a)) -> Propagator a)
-> (Network -> Either Error (Network, a)) -> Propagator a
forall a b. (a -> b) -> a -> b
$ \Network
_ -> Error -> Either Error (Network, a)
forall a b. a -> Either a b
Left Error
e
addPropagator :: Prop -> Propagator ConnectKey
addPropagator :: Prop -> Propagator ConnectKey
addPropagator Prop
prop =
(Network -> Either Error (Network, ConnectKey))
-> Propagator ConnectKey
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, ConnectKey))
-> Propagator ConnectKey)
-> (Network -> Either Error (Network, ConnectKey))
-> Propagator ConnectKey
forall a b. (a -> b) -> a -> b
$ \Network
net ->
let
nextInt :: Int
nextInt = Network -> Int
nextRawConnectKey Network
net
in
(Network, ConnectKey) -> Either Error (Network, ConnectKey)
forall a b. b -> Either a b
Right
( Network
net
{ nextRawConnectKey = nextInt + 1
, propagators = M.insert nextInt prop (propagators net)
}
, Int -> ConnectKey
ConnectKey Int
nextInt
)
getCell :: CellKey a -> Propagator (Cell a)
getCell :: forall a. CellKey a -> Propagator (Cell a)
getCell ck :: CellKey a
ck@(CellKey Int
k) =
(Network -> Either Error (Network, Cell a)) -> Propagator (Cell a)
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, Cell a))
-> Propagator (Cell a))
-> (Network -> Either Error (Network, Cell a))
-> Propagator (Cell a)
forall a b. (a -> b) -> a -> b
$ \Network
net ->
Error -> Maybe (Network, Cell a) -> Either Error (Network, Cell a)
forall a. Error -> Maybe a -> Either Error a
toError (Some CellKey -> Error
InvalidCell (CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey a
ck)) (Maybe (Network, Cell a) -> Either Error (Network, Cell a))
-> Maybe (Network, Cell a) -> Either Error (Network, Cell a)
forall a b. (a -> b) -> a -> b
$ do
Some Cell a
prop <- Int -> IntMap (Some Cell) -> Maybe (Some Cell)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
k (Network -> IntMap (Some Cell)
cells Network
net)
(Network, Cell a) -> Maybe (Network, Cell a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network
net, Cell a -> Cell a
forall a b. a -> b
unsafeCoerce Cell a
prop)
getPropagator :: ConnectKey -> Propagator Prop
getPropagator :: ConnectKey -> Propagator Prop
getPropagator key :: ConnectKey
key@(ConnectKey Int
k) =
(Network -> Either Error (Network, Prop)) -> Propagator Prop
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, Prop)) -> Propagator Prop)
-> (Network -> Either Error (Network, Prop)) -> Propagator Prop
forall a b. (a -> b) -> a -> b
$ \Network
net ->
Error -> Maybe (Network, Prop) -> Either Error (Network, Prop)
forall a. Error -> Maybe a -> Either Error a
toError (ConnectKey -> Error
InvalidConnect ConnectKey
key) (Maybe (Network, Prop) -> Either Error (Network, Prop))
-> Maybe (Network, Prop) -> Either Error (Network, Prop)
forall a b. (a -> b) -> a -> b
$ do
Prop
prop <- Int -> IntMap Prop -> Maybe Prop
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
k (Network -> IntMap Prop
propagators Network
net)
(Network, Prop) -> Maybe (Network, Prop)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network
net, Prop
prop)
extractPropagator :: ConnectKey -> Propagator Prop
key :: ConnectKey
key@(ConnectKey Int
k) =
(Network -> Either Error (Network, Prop)) -> Propagator Prop
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, Prop)) -> Propagator Prop)
-> (Network -> Either Error (Network, Prop)) -> Propagator Prop
forall a b. (a -> b) -> a -> b
$ \Network
net ->
let
(Maybe Prop
maybeProp, IntMap Prop
newPropagators) =
(Int -> Prop -> Maybe Prop)
-> Int -> IntMap Prop -> (Maybe Prop, IntMap Prop)
forall a.
(Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
M.updateLookupWithKey (\Int
_ Prop
_ -> Maybe Prop
forall a. Maybe a
Nothing) Int
k (Network -> IntMap Prop
propagators Network
net)
in do
Prop
prop <- Error -> Maybe Prop -> Either Error Prop
forall a. Error -> Maybe a -> Either Error a
toError (ConnectKey -> Error
InvalidConnect ConnectKey
key) Maybe Prop
maybeProp
(Network, Prop) -> Either Error (Network, Prop)
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network
net { propagators = newPropagators }, Prop
prop)
modifyCells :: (M.IntMap (Some Cell) -> M.IntMap (Some Cell)) -> Propagator ()
modifyCells :: (IntMap (Some Cell) -> IntMap (Some Cell)) -> Propagator ()
modifyCells IntMap (Some Cell) -> IntMap (Some Cell)
f =
(Network -> Either Error (Network, ())) -> Propagator ()
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, ())) -> Propagator ())
-> (Network -> Either Error (Network, ())) -> Propagator ()
forall a b. (a -> b) -> a -> b
$ \Network
net ->
(Network, ()) -> Either Error (Network, ())
forall a b. b -> Either a b
Right
(Network
net { cells = f (cells net) }, ())
modifyCell :: (Some Cell -> Some Cell) -> Some CellKey -> Propagator ()
modifyCell :: (Some Cell -> Some Cell) -> Some CellKey -> Propagator ()
modifyCell Some Cell -> Some Cell
f (Some key :: CellKey a
key@(CellKey Int
k)) =
(Network -> Either Error (Network, ())) -> Propagator ()
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, ())) -> Propagator ())
-> (Network -> Either Error (Network, ())) -> Propagator ()
forall a b. (a -> b) -> a -> b
$ \Network
net -> do
IntMap (Some Cell)
newCells <- (Maybe (Some Cell) -> Either Error (Maybe (Some Cell)))
-> Int -> IntMap (Some Cell) -> Either Error (IntMap (Some Cell))
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Int -> IntMap a -> f (IntMap a)
M.alterF Maybe (Some Cell) -> Either Error (Maybe (Some Cell))
g Int
k (Network -> IntMap (Some Cell)
cells Network
net)
(Network, ()) -> Either Error (Network, ())
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network
net { cells = newCells }, ())
where
g :: Maybe (Some Cell) -> Either Error (Maybe (Some Cell))
g Maybe (Some Cell)
Nothing = Error -> Either Error (Maybe (Some Cell))
forall a b. a -> Either a b
Left (Some CellKey -> Error
InvalidCell (CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey a
key))
g (Just Some Cell
c) = Maybe (Some Cell) -> Either Error (Maybe (Some Cell))
forall a b. b -> Either a b
Right (Maybe (Some Cell) -> Either Error (Maybe (Some Cell)))
-> Maybe (Some Cell) -> Either Error (Maybe (Some Cell))
forall a b. (a -> b) -> a -> b
$ Some Cell -> Maybe (Some Cell)
forall a. a -> Maybe a
Just (Some Cell -> Some Cell
f Some Cell
c)
empty :: Network
empty :: Network
empty = Int -> Int -> IntMap (Some Cell) -> IntMap Prop -> Network
Network Int
0 Int
0 IntMap (Some Cell)
forall a. IntMap a
M.empty IntMap Prop
forall a. IntMap a
M.empty
cell
:: (CellKey a -> a)
-> (a -> a -> Change a)
-> Propagator (CellKey a)
cell :: forall a.
(CellKey a -> a) -> (a -> a -> Change a) -> Propagator (CellKey a)
cell CellKey a -> a
initValue a -> a -> Change a
f =
(Network -> Either Error (Network, CellKey a))
-> Propagator (CellKey a)
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, CellKey a))
-> Propagator (CellKey a))
-> (Network -> Either Error (Network, CellKey a))
-> Propagator (CellKey a)
forall a b. (a -> b) -> a -> b
$ \Network
net ->
let
nextInt :: Int
nextInt = Network -> Int
nextRawCellKey Network
net
nextKey :: CellKey a
nextKey = Int -> CellKey a
forall a. Int -> CellKey a
CellKey Int
nextInt
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 (CellKey a -> a
initValue CellKey a
nextKey) a -> a -> Change a
f IntSet
S.empty IntSet
S.empty
net' :: Network
net' =
Network
net
{ nextRawCellKey = nextInt + 1
, cells = M.insert nextInt (Some newCell) (cells net)
}
in
(Network, CellKey a) -> Either Error (Network, CellKey a)
forall a b. b -> Either a b
Right (Network
net', CellKey a
nextKey)
readCell :: CellKey a -> Propagator a
readCell :: forall a. CellKey a -> Propagator a
readCell CellKey a
k = Cell a -> a
forall a. Cell a -> a
value (Cell a -> a) -> Propagator (Cell a) -> Propagator a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CellKey a -> Propagator (Cell a)
forall a. CellKey a -> Propagator (Cell a)
getCell CellKey a
k
writeCell :: a -> CellKey a -> Propagator ()
writeCell :: forall a. a -> CellKey a -> Propagator ()
writeCell a
newValue ck :: CellKey a
ck@(CellKey Int
k) =
(Network -> Either Error (Network, ())) -> Propagator ()
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, ())) -> Propagator ())
-> (Network -> Either Error (Network, ())) -> Propagator ()
forall a b. (a -> b) -> a -> b
$ \Network
net -> do
(IntSet
subs, IntMap (Some Cell)
newCells) <- Compose (Either Error) ((,) IntSet) (IntMap (Some Cell))
-> Either Error (IntSet, IntMap (Some Cell))
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (Either Error) ((,) IntSet) (IntMap (Some Cell))
-> Either Error (IntSet, IntMap (Some Cell)))
-> Compose (Either Error) ((,) IntSet) (IntMap (Some Cell))
-> Either Error (IntSet, IntMap (Some Cell))
forall a b. (a -> b) -> a -> b
$ (Maybe (Some Cell)
-> Compose (Either Error) ((,) IntSet) (Maybe (Some Cell)))
-> Int
-> IntMap (Some Cell)
-> Compose (Either Error) ((,) IntSet) (IntMap (Some Cell))
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Int -> IntMap a -> f (IntMap a)
M.alterF Maybe (Some Cell)
-> Compose (Either Error) ((,) IntSet) (Maybe (Some Cell))
change Int
k (Network -> IntMap (Some Cell)
cells Network
net)
(Propagator () -> Network -> Either Error (Network, ()))
-> Network -> Propagator () -> Either Error (Network, ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip Propagator () -> Network -> Either Error (Network, ())
forall a. Propagator a -> Network -> Either Error (Network, a)
runPropagator Network
net { cells = newCells } (Propagator () -> Either Error (Network, ()))
-> Propagator () -> Either Error (Network, ())
forall a b. (a -> b) -> a -> b
$
(Int -> Propagator ()) -> [Int] -> Propagator ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
(ConnectKey -> Propagator ()
fire (ConnectKey -> Propagator ())
-> (Int -> ConnectKey) -> Int -> Propagator ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConnectKey
ConnectKey)
(IntSet -> [Int]
S.elems IntSet
subs)
where
change :: Maybe (Some Cell)
-> Compose (Either Error) ((,) IntSet) (Maybe (Some Cell))
change Maybe (Some Cell)
maybeCell =
Either Error (IntSet, Maybe (Some Cell))
-> Compose (Either Error) ((,) IntSet) (Maybe (Some Cell))
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Either Error (IntSet, Maybe (Some Cell))
-> Compose (Either Error) ((,) IntSet) (Maybe (Some Cell)))
-> Either Error (IntSet, Maybe (Some Cell))
-> Compose (Either Error) ((,) IntSet) (Maybe (Some Cell))
forall a b. (a -> b) -> a -> b
$
case Maybe (Some Cell)
maybeCell of
Maybe (Some Cell)
Nothing ->
Error -> Either Error (IntSet, Maybe (Some Cell))
forall a b. a -> Either a b
Left (Some CellKey -> Error
InvalidCell (CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey a
ck))
Just s :: Some Cell
s@(Some Cell a
someCell) ->
let
c :: Cell a
c@(Cell {a
value :: forall a. Cell a -> a
value :: a
value}) = Cell a -> Cell a
forall a b. a -> b
unsafeCoerce Cell a
someCell
in
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 ->
(IntSet, Maybe (Some Cell))
-> Either Error (IntSet, Maybe (Some Cell))
forall a b. b -> Either a b
Right (Cell a -> IntSet
forall a. Cell a -> IntSet
subscribers Cell a
c, Some Cell -> Maybe (Some Cell)
forall a. a -> Maybe a
Just (Cell a -> Some Cell
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some Cell a
c { value = new }))
Unchanged a
_ ->
(IntSet, Maybe (Some Cell))
-> Either Error (IntSet, Maybe (Some Cell))
forall a b. b -> Either a b
Right (IntSet
S.empty, Some Cell -> Maybe (Some Cell)
forall a. a -> Maybe a
Just Some Cell
s)
Change a
Incompatible ->
Error -> Either Error (IntSet, Maybe (Some Cell))
forall a b. a -> Either a b
Left (Some CellKey -> Error
Conflict (CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey a
ck))
removeCell :: CellKey a -> Propagator ()
removeCell :: forall a. CellKey a -> Propagator ()
removeCell key :: CellKey a
key@(CellKey Int
k) = do
Cell a
theCell <- CellKey a -> Propagator (Cell a)
forall a. CellKey a -> Propagator (Cell a)
getCell CellKey a
key
(Int -> Propagator ()) -> [Int] -> Propagator ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
(ConnectKey -> Propagator ()
disconnect (ConnectKey -> Propagator ())
-> (Int -> ConnectKey) -> Int -> Propagator ()
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 (Some Cell) -> IntMap (Some Cell)) -> Propagator ()
modifyCells (Int -> IntMap (Some Cell) -> IntMap (Some Cell)
forall a. Int -> IntMap a -> IntMap a
M.delete Int
k)
label :: (a -> [b]) -> (b -> a) -> [CellKey a] -> Propagator [[b]]
label :: forall a b.
(a -> [b]) -> (b -> a) -> [CellKey a] -> Propagator [[b]]
label a -> [b]
elems b -> a
reify = [b] -> [CellKey a] -> Propagator [[b]]
solve [] ([CellKey a] -> Propagator [[b]])
-> ([CellKey a] -> [CellKey a]) -> [CellKey a] -> Propagator [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CellKey a] -> [CellKey a]
forall a. [a] -> [a]
reverse
where
solve :: [b] -> [CellKey a] -> Propagator [[b]]
solve [b]
current [] = [[b]] -> Propagator [[b]]
forall a. a -> Propagator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[b]
current]
solve [b]
current (CellKey a
k:[CellKey a]
ks) =
(Network -> Either Error (Network, [[b]])) -> Propagator [[b]]
forall a. (Network -> Either Error (Network, a)) -> Propagator a
Propagator ((Network -> Either Error (Network, [[b]])) -> Propagator [[b]])
-> (Network -> Either Error (Network, [[b]])) -> Propagator [[b]]
forall a b. (a -> b) -> a -> b
$ \Network
net -> do
(Network
net',a
a) <- Propagator a -> Network -> Either Error (Network, a)
forall a. Propagator a -> Network -> Either Error (Network, a)
runPropagator (CellKey a -> Propagator a
forall a. CellKey a -> Propagator a
readCell CellKey a
k) Network
net
[[[b]]]
solutions <-
[b] -> (b -> Either Error [[b]]) -> Either Error [[[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 [[b]]) -> Either Error [[[b]]])
-> (b -> Either Error [[b]]) -> Either Error [[[b]]]
forall a b. (a -> b) -> a -> b
$ \b
b ->
case Propagator () -> Network -> Either Error (Network, ())
forall a. Propagator a -> Network -> Either Error (Network, a)
runPropagator (a -> CellKey a -> Propagator ()
forall a. a -> CellKey a -> Propagator ()
writeCell (b -> a
reify b
b) CellKey a
k) Network
net' of
Right (Network
net'',()) ->
(Network, [[b]]) -> [[b]]
forall a b. (a, b) -> b
snd ((Network, [[b]]) -> [[b]])
-> Either Error (Network, [[b]]) -> Either Error [[b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propagator [[b]] -> Network -> Either Error (Network, [[b]])
forall a. Propagator a -> Network -> Either Error (Network, a)
runPropagator ([b] -> [CellKey a] -> Propagator [[b]]
solve (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
current) [CellKey a]
ks) Network
net''
Left Error
_ ->
[[b]] -> Either Error [[b]]
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
(Network, [[b]]) -> Either Error (Network, [[b]])
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network
net, [[[b]]] -> [[b]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[b]]]
solutions)
propagator :: ConnectState -> Prop -> Propagator ConnectKey
propagator :: ConnectState -> Prop -> Propagator ConnectKey
propagator ConnectState
state Prop
prop = do
key :: ConnectKey
key@(ConnectKey Int
k) <- Prop -> Propagator ConnectKey
addPropagator Prop
prop
(Some CellKey -> Propagator ()) -> [Some CellKey] -> Propagator ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Some Cell -> Some Cell) -> Some CellKey -> Propagator ()
modifyCell ((Some Cell -> Some Cell) -> Some CellKey -> Propagator ())
-> (Some Cell -> Some Cell) -> Some CellKey -> Propagator ()
forall a b. (a -> b) -> a -> b
$ Int -> Some Cell -> Some Cell
addSub Int
k) (Prop -> [Some CellKey]
sources Prop
prop)
(Some CellKey -> Propagator ()) -> [Some CellKey] -> Propagator ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Some Cell -> Some Cell) -> Some CellKey -> Propagator ()
modifyCell ((Some Cell -> Some Cell) -> Some CellKey -> Propagator ())
-> (Some Cell -> Some Cell) -> Some CellKey -> Propagator ()
forall a b. (a -> b) -> a -> b
$ Int -> Some Cell -> Some Cell
addInc Int
k) (Prop -> [Some CellKey]
targets Prop
prop)
case ConnectState
state of
ConnectState
Live -> ConnectKey -> Propagator ()
fire ConnectKey
key Propagator () -> Propagator ConnectKey -> Propagator ConnectKey
forall a b. Propagator a -> Propagator b -> Propagator b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConnectKey -> Propagator ConnectKey
forall a. a -> Propagator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectKey
key
ConnectState
Idle -> ConnectKey -> Propagator ConnectKey
forall a. a -> Propagator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectKey
key
where
addSub :: Int -> Some Cell -> Some Cell
addSub Int
k (Some Cell a
c) = Cell a -> Some Cell
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some Cell a
c { subscribers = S.insert k (subscribers c) }
addInc :: Int -> Some Cell -> Some Cell
addInc Int
k (Some Cell a
c) = Cell a -> Some Cell
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some Cell a
c { incomings = S.insert k (incomings c) }
connect :: ConnectState -> CellKey a -> CellKey b -> (a -> Maybe b) -> Propagator ConnectKey
connect :: forall a b.
ConnectState
-> CellKey a
-> CellKey b
-> (a -> Maybe b)
-> Propagator ConnectKey
connect ConnectState
state CellKey a
source CellKey b
target a -> Maybe b
f =
ConnectState -> Prop -> Propagator ConnectKey
propagator ConnectState
state (Prop -> Propagator ConnectKey) -> Prop -> Propagator ConnectKey
forall a b. (a -> b) -> a -> b
$ [Some CellKey]
-> [Some CellKey] -> (ConnectKey -> Propagator ()) -> Prop
Prop [CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey a
source] [CellKey b -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey b
target] ((ConnectKey -> Propagator ()) -> Prop)
-> (ConnectKey -> Propagator ()) -> Prop
forall a b. (a -> b) -> a -> b
$
\ConnectKey
key -> do
a
ins <- CellKey a -> Propagator a
forall a. CellKey a -> Propagator a
readCell CellKey a
source
b
out <- Error -> Maybe b -> Propagator b
forall a. Error -> Maybe a -> Propagator a
toPropagator (ConnectKey -> Error
NoPropagation ConnectKey
key) (a -> Maybe b
f a
ins)
b -> CellKey b -> Propagator ()
forall a. a -> CellKey a -> Propagator ()
writeCell b
out CellKey b
target
connect_ :: ConnectState -> CellKey a -> CellKey b -> (a -> Maybe b) -> Propagator ()
connect_ :: forall a b.
ConnectState
-> CellKey a -> CellKey b -> (a -> Maybe b) -> Propagator ()
connect_ ConnectState
state CellKey a
source CellKey b
target a -> Maybe b
f =
Propagator ConnectKey -> Propagator ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator ConnectKey -> Propagator ())
-> Propagator ConnectKey -> Propagator ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKey a
-> CellKey b
-> (a -> Maybe b)
-> Propagator ConnectKey
forall a b.
ConnectState
-> CellKey a
-> CellKey b
-> (a -> Maybe b)
-> Propagator ConnectKey
connect ConnectState
state CellKey a
source CellKey b
target a -> Maybe b
f
sync :: ConnectState -> CellKey a -> CellKey a -> Propagator (ConnectKey, ConnectKey)
sync :: forall a.
ConnectState
-> CellKey a -> CellKey a -> Propagator (ConnectKey, ConnectKey)
sync = (a -> Maybe a)
-> (a -> Maybe a)
-> ConnectState
-> CellKey a
-> CellKey a
-> Propagator (ConnectKey, ConnectKey)
forall a b.
(a -> Maybe b)
-> (b -> Maybe a)
-> ConnectState
-> CellKey a
-> CellKey b
-> Propagator (ConnectKey, ConnectKey)
syncWith a -> Maybe a
forall a. a -> Maybe a
Just a -> Maybe a
forall a. a -> Maybe a
Just
sync_ :: ConnectState -> CellKey a -> CellKey a -> Propagator ()
sync_ :: forall a. ConnectState -> CellKey a -> CellKey a -> Propagator ()
sync_ ConnectState
state CellKey a
c1 CellKey a
c2 =
Propagator (ConnectKey, ConnectKey) -> Propagator ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator (ConnectKey, ConnectKey) -> Propagator ())
-> Propagator (ConnectKey, ConnectKey) -> Propagator ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKey a -> CellKey a -> Propagator (ConnectKey, ConnectKey)
forall a.
ConnectState
-> CellKey a -> CellKey a -> Propagator (ConnectKey, ConnectKey)
sync ConnectState
state CellKey a
c1 CellKey a
c2
syncWith
:: (a -> Maybe b)
-> (b -> Maybe a)
-> ConnectState
-> CellKey a
-> CellKey b
-> Propagator (ConnectKey, ConnectKey)
syncWith :: forall a b.
(a -> Maybe b)
-> (b -> Maybe a)
-> ConnectState
-> CellKey a
-> CellKey b
-> Propagator (ConnectKey, ConnectKey)
syncWith a -> Maybe b
f b -> Maybe a
g ConnectState
state CellKey a
c1 CellKey b
c2 = do
ConnectKey
key1 <- ConnectState
-> CellKey a
-> CellKey b
-> (a -> Maybe b)
-> Propagator ConnectKey
forall a b.
ConnectState
-> CellKey a
-> CellKey b
-> (a -> Maybe b)
-> Propagator ConnectKey
connect ConnectState
state CellKey a
c1 CellKey b
c2 a -> Maybe b
f
ConnectKey
key2 <- ConnectState
-> CellKey b
-> CellKey a
-> (b -> Maybe a)
-> Propagator ConnectKey
forall a b.
ConnectState
-> CellKey a
-> CellKey b
-> (a -> Maybe b)
-> Propagator ConnectKey
connect ConnectState
state CellKey b
c2 CellKey a
c1 b -> Maybe a
g
(ConnectKey, ConnectKey) -> Propagator (ConnectKey, ConnectKey)
forall a. a -> Propagator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectKey
key1, ConnectKey
key2)
syncWith_
:: (a -> Maybe b)
-> (b -> Maybe a)
-> ConnectState
-> CellKey a
-> CellKey b
-> Propagator ()
syncWith_ :: forall a b.
(a -> Maybe b)
-> (b -> Maybe a)
-> ConnectState
-> CellKey a
-> CellKey b
-> Propagator ()
syncWith_ a -> Maybe b
f b -> Maybe a
g ConnectState
state CellKey a
c1 CellKey b
c2 =
Propagator (ConnectKey, ConnectKey) -> Propagator ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator (ConnectKey, ConnectKey) -> Propagator ())
-> Propagator (ConnectKey, ConnectKey) -> Propagator ()
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b)
-> (b -> Maybe a)
-> ConnectState
-> CellKey a
-> CellKey b
-> Propagator (ConnectKey, ConnectKey)
forall a b.
(a -> Maybe b)
-> (b -> Maybe a)
-> ConnectState
-> CellKey a
-> CellKey b
-> Propagator (ConnectKey, ConnectKey)
syncWith a -> Maybe b
f b -> Maybe a
g ConnectState
state CellKey a
c1 CellKey b
c2
combine :: ConnectState -> CellKey a -> CellKey b -> CellKey c -> (a -> b -> Maybe c) -> Propagator ConnectKey
combine :: forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ConnectKey
combine ConnectState
state CellKey a
source1 CellKey b
source2 CellKey c
target a -> b -> Maybe c
f =
ConnectState -> Prop -> Propagator ConnectKey
propagator ConnectState
state (Prop -> Propagator ConnectKey) -> Prop -> Propagator ConnectKey
forall a b. (a -> b) -> a -> b
$ [Some CellKey]
-> [Some CellKey] -> (ConnectKey -> Propagator ()) -> Prop
Prop [CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey a
source1, CellKey b -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey b
source2] [CellKey c -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey c
target] ((ConnectKey -> Propagator ()) -> Prop)
-> (ConnectKey -> Propagator ()) -> Prop
forall a b. (a -> b) -> a -> b
$
\ConnectKey
key -> do
a
in1 <- CellKey a -> Propagator a
forall a. CellKey a -> Propagator a
readCell CellKey a
source1
b
in2 <- CellKey b -> Propagator b
forall a. CellKey a -> Propagator a
readCell CellKey b
source2
c
out <- Error -> Maybe c -> Propagator c
forall a. Error -> Maybe a -> Propagator a
toPropagator (ConnectKey -> Error
NoPropagation ConnectKey
key) (a -> b -> Maybe c
f a
in1 b
in2)
c -> CellKey c -> Propagator ()
forall a. a -> CellKey a -> Propagator ()
writeCell c
out CellKey c
target
combine_ :: ConnectState -> CellKey a -> CellKey b -> CellKey c -> (a -> b -> Maybe c) -> Propagator ()
combine_ :: forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
source1 CellKey b
source2 CellKey c
target a -> b -> Maybe c
f =
Propagator ConnectKey -> Propagator ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator ConnectKey -> Propagator ())
-> Propagator ConnectKey -> Propagator ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ConnectKey
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ConnectKey
combine ConnectState
state CellKey a
source1 CellKey b
source2 CellKey c
target a -> b -> Maybe c
f
combineMany :: ConnectState -> CellKeys ts -> CellKey a -> (CellValues ts -> Maybe a) -> Propagator ConnectKey
combineMany :: forall (ts :: [*]) a.
ConnectState
-> CellKeys ts
-> CellKey a
-> (CellValues ts -> Maybe a)
-> Propagator ConnectKey
combineMany ConnectState
state CellKeys ts
sources CellKey a
target CellValues ts -> Maybe a
f =
ConnectState -> Prop -> Propagator ConnectKey
propagator ConnectState
state (Prop -> Propagator ConnectKey) -> Prop -> Propagator ConnectKey
forall a b. (a -> b) -> a -> b
$ [Some CellKey]
-> [Some CellKey] -> (ConnectKey -> Propagator ()) -> Prop
Prop (CellKeys ts -> [Some CellKey]
forall (ts :: [*]). CellKeys ts -> [Some CellKey]
someKeys CellKeys ts
sources) [CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey a
target] ((ConnectKey -> Propagator ()) -> Prop)
-> (ConnectKey -> Propagator ()) -> Prop
forall a b. (a -> b) -> a -> b
$
\ConnectKey
key -> do
CellValues ts
ins <- CellKeys ts -> Propagator (CellValues ts)
forall (ts :: [*]). CellKeys ts -> Propagator (CellValues ts)
readValues CellKeys ts
sources
a
out <- Error -> Maybe a -> Propagator a
forall a. Error -> Maybe a -> Propagator a
toPropagator (ConnectKey -> Error
NoPropagation ConnectKey
key) (CellValues ts -> Maybe a
f CellValues ts
ins)
a -> CellKey a -> Propagator ()
forall a. a -> CellKey a -> Propagator ()
writeCell a
out CellKey a
target
combineMany_ :: ConnectState -> CellKeys ts -> CellKey a -> (CellValues ts -> Maybe a) -> Propagator ()
combineMany_ :: forall (ts :: [*]) a.
ConnectState
-> CellKeys ts
-> CellKey a
-> (CellValues ts -> Maybe a)
-> Propagator ()
combineMany_ ConnectState
state CellKeys ts
sources CellKey a
target CellValues ts -> Maybe a
f =
Propagator ConnectKey -> Propagator ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator ConnectKey -> Propagator ())
-> Propagator ConnectKey -> Propagator ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKeys ts
-> CellKey a
-> (CellValues ts -> Maybe a)
-> Propagator ConnectKey
forall (ts :: [*]) a.
ConnectState
-> CellKeys ts
-> CellKey a
-> (CellValues ts -> Maybe a)
-> Propagator ConnectKey
combineMany ConnectState
state CellKeys ts
sources CellKey a
target CellValues ts -> Maybe a
f
distribute :: ConnectState -> CellKey a -> [CellKey b] -> (a -> Maybe b) -> Propagator ConnectKey
distribute :: forall a b.
ConnectState
-> CellKey a
-> [CellKey b]
-> (a -> Maybe b)
-> Propagator ConnectKey
distribute ConnectState
state CellKey a
source [CellKey b]
targets a -> Maybe b
f =
ConnectState -> Prop -> Propagator ConnectKey
propagator ConnectState
state (Prop -> Propagator ConnectKey) -> Prop -> Propagator ConnectKey
forall a b. (a -> b) -> a -> b
$ [Some CellKey]
-> [Some CellKey] -> (ConnectKey -> Propagator ()) -> Prop
Prop [CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some CellKey a
source] ((CellKey b -> Some CellKey) -> [CellKey b] -> [Some CellKey]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CellKey b -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some [CellKey b]
targets) ((ConnectKey -> Propagator ()) -> Prop)
-> (ConnectKey -> Propagator ()) -> Prop
forall a b. (a -> b) -> a -> b
$
\ConnectKey
key -> do
a
ins <- CellKey a -> Propagator a
forall a. CellKey a -> Propagator a
readCell CellKey a
source
b
out <- Error -> Maybe b -> Propagator b
forall a. Error -> Maybe a -> Propagator a
toPropagator (ConnectKey -> Error
NoPropagation ConnectKey
key) (a -> Maybe b
f a
ins)
(CellKey b -> Propagator ()) -> [CellKey b] -> Propagator ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (b -> CellKey b -> Propagator ()
forall a. a -> CellKey a -> Propagator ()
writeCell b
out) [CellKey b]
targets
distribute_ :: ConnectState -> CellKey a -> [CellKey b] -> (a -> Maybe b) -> Propagator ()
distribute_ :: forall a b.
ConnectState
-> CellKey a -> [CellKey b] -> (a -> Maybe b) -> Propagator ()
distribute_ ConnectState
state CellKey a
source [CellKey b]
targets a -> Maybe b
f =
Propagator ConnectKey -> Propagator ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator ConnectKey -> Propagator ())
-> Propagator ConnectKey -> Propagator ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKey a
-> [CellKey b]
-> (a -> Maybe b)
-> Propagator ConnectKey
forall a b.
ConnectState
-> CellKey a
-> [CellKey b]
-> (a -> Maybe b)
-> Propagator ConnectKey
distribute ConnectState
state CellKey a
source [CellKey b]
targets a -> Maybe b
f
manyToMany :: ConnectState -> CellKeys xs -> [CellKey a] -> (CellValues xs -> Maybe a) -> Propagator ConnectKey
manyToMany :: forall (xs :: [*]) a.
ConnectState
-> CellKeys xs
-> [CellKey a]
-> (CellValues xs -> Maybe a)
-> Propagator ConnectKey
manyToMany ConnectState
state CellKeys xs
sources [CellKey a]
targets CellValues xs -> Maybe a
f =
ConnectState -> Prop -> Propagator ConnectKey
propagator ConnectState
state (Prop -> Propagator ConnectKey) -> Prop -> Propagator ConnectKey
forall a b. (a -> b) -> a -> b
$ [Some CellKey]
-> [Some CellKey] -> (ConnectKey -> Propagator ()) -> Prop
Prop (CellKeys xs -> [Some CellKey]
forall (ts :: [*]). CellKeys ts -> [Some CellKey]
someKeys CellKeys xs
sources) ((CellKey a -> Some CellKey) -> [CellKey a] -> [Some CellKey]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CellKey a -> Some CellKey
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some [CellKey a]
targets) ((ConnectKey -> Propagator ()) -> Prop)
-> (ConnectKey -> Propagator ()) -> Prop
forall a b. (a -> b) -> a -> b
$
\ConnectKey
key -> do
CellValues xs
ins <- CellKeys xs -> Propagator (CellValues xs)
forall (ts :: [*]). CellKeys ts -> Propagator (CellValues ts)
readValues CellKeys xs
sources
a
out <- Error -> Maybe a -> Propagator a
forall a. Error -> Maybe a -> Propagator a
toPropagator (ConnectKey -> Error
NoPropagation ConnectKey
key) (CellValues xs -> Maybe a
f CellValues xs
ins)
(CellKey a -> Propagator ()) -> [CellKey a] -> Propagator ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (a -> CellKey a -> Propagator ()
forall a. a -> CellKey a -> Propagator ()
writeCell a
out) [CellKey a]
targets
manyToMany_ :: ConnectState -> CellKeys xs -> [CellKey a] -> (CellValues xs -> Maybe a) -> Propagator ()
manyToMany_ :: forall (xs :: [*]) a.
ConnectState
-> CellKeys xs
-> [CellKey a]
-> (CellValues xs -> Maybe a)
-> Propagator ()
manyToMany_ ConnectState
state CellKeys xs
sources [CellKey a]
targets CellValues xs -> Maybe a
f =
Propagator ConnectKey -> Propagator ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Propagator ConnectKey -> Propagator ())
-> Propagator ConnectKey -> Propagator ()
forall a b. (a -> b) -> a -> b
$ ConnectState
-> CellKeys xs
-> [CellKey a]
-> (CellValues xs -> Maybe a)
-> Propagator ConnectKey
forall (xs :: [*]) a.
ConnectState
-> CellKeys xs
-> [CellKey a]
-> (CellValues xs -> Maybe a)
-> Propagator ConnectKey
manyToMany ConnectState
state CellKeys xs
sources [CellKey a]
targets CellValues xs -> Maybe a
f
disconnect :: ConnectKey -> Propagator ()
disconnect :: ConnectKey -> Propagator ()
disconnect key :: ConnectKey
key@(ConnectKey Int
k) = do
Prop
prop <- ConnectKey -> Propagator Prop
extractPropagator ConnectKey
key
(Some CellKey -> Propagator ()) -> [Some CellKey] -> Propagator ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Some Cell -> Some Cell) -> Some CellKey -> Propagator ()
modifyCell Some Cell -> Some Cell
removeSub) (Prop -> [Some CellKey]
sources Prop
prop)
(Some CellKey -> Propagator ()) -> [Some CellKey] -> Propagator ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Some Cell -> Some Cell) -> Some CellKey -> Propagator ()
modifyCell Some Cell -> Some Cell
removeInc) (Prop -> [Some CellKey]
targets Prop
prop)
where
removeSub :: Some Cell -> Some Cell
removeSub (Some Cell a
c) =
Cell a -> Some Cell
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some Cell a
c { subscribers = S.delete k (subscribers c) }
removeInc :: Some Cell -> Some Cell
removeInc (Some Cell a
c) =
Cell a -> Some Cell
forall {k} (t :: k -> *) (a :: k). t a -> Some t
Some Cell a
c { incomings = S.delete k (incomings c) }
fire :: ConnectKey -> Propagator ()
fire :: ConnectKey -> Propagator ()
fire ConnectKey
k = do
Prop
prop <- ConnectKey -> Propagator Prop
getPropagator ConnectKey
k
Prop -> ConnectKey -> Propagator ()
action Prop
prop ConnectKey
k
data Error
= InvalidCell (Some CellKey)
| InvalidConnect ConnectKey
| NoPropagation ConnectKey
| Conflict (Some CellKey)
toError :: Error -> Maybe a -> Either Error a
toError :: forall a. Error -> Maybe a -> Either Error a
toError Error
_ (Just a
a) = a -> Either Error a
forall a b. b -> Either a b
Right a
a
toError Error
e Maybe a
Nothing = Error -> Either Error a
forall a b. a -> Either a b
Left Error
e
toPropagator :: Error -> Maybe a -> Propagator a
toPropagator :: forall a. Error -> Maybe a -> Propagator a
toPropagator Error
e Maybe a
m =
case Maybe a
m of
Just a
a -> a -> Propagator a
forall a. a -> Propagator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Maybe a
Nothing -> Error -> Propagator a
forall a. Error -> Propagator a
failWith Error
e
plus :: Num a => ConnectState -> CellKey a -> CellKey a -> CellKey a -> Propagator ()
plus :: forall a.
Num a =>
ConnectState
-> CellKey a -> CellKey a -> CellKey a -> Propagator ()
plus ConnectState
state CellKey a
left CellKey a
right CellKey a
result = do
ConnectState
-> CellKey a
-> CellKey a
-> CellKey a
-> (a -> a -> Maybe a)
-> Propagator ()
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
left CellKey a
right CellKey a
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 a
-> CellKey a
-> CellKey a
-> (a -> a -> Maybe a)
-> Propagator ()
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
left CellKey a
result CellKey a
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 a
-> CellKey a
-> CellKey a
-> (a -> a -> Maybe a)
-> Propagator ()
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
right CellKey a
result CellKey a
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 :: Num a => ConnectState -> CellKey a -> CellKey a -> CellKey a -> Propagator ()
minus :: forall a.
Num a =>
ConnectState
-> CellKey a -> CellKey a -> CellKey a -> Propagator ()
minus ConnectState
state CellKey a
left CellKey a
right CellKey a
result = do
ConnectState
-> CellKey a
-> CellKey a
-> CellKey a
-> (a -> a -> Maybe a)
-> Propagator ()
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
left CellKey a
right CellKey a
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 a
-> CellKey a
-> CellKey a
-> (a -> a -> Maybe a)
-> Propagator ()
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
left CellKey a
result CellKey a
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 a
-> CellKey a
-> CellKey a
-> (a -> a -> Maybe a)
-> Propagator ()
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
right CellKey a
result CellKey a
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 :: Num a => ConnectState -> CellKey a -> CellKey a -> CellKey a -> Propagator ()
times :: forall a.
Num a =>
ConnectState
-> CellKey a -> CellKey a -> CellKey a -> Propagator ()
times ConnectState
state CellKey a
left CellKey a
right CellKey a
result =
ConnectState
-> CellKey a
-> CellKey a
-> CellKey a
-> (a -> a -> Maybe a)
-> Propagator ()
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
left CellKey a
right CellKey a
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 :: Num a => (a -> a -> a) -> ConnectState -> CellKey a -> CellKey a -> CellKey a -> Propagator ()
timesWith :: forall a.
Num a =>
(a -> a -> a)
-> ConnectState
-> CellKey a
-> CellKey a
-> CellKey a
-> Propagator ()
timesWith a -> a -> a
divOp ConnectState
state CellKey a
left CellKey a
right CellKey a
result = do
ConnectState
-> CellKey a -> CellKey a -> CellKey a -> Propagator ()
forall a.
Num a =>
ConnectState
-> CellKey a -> CellKey a -> CellKey a -> Propagator ()
times ConnectState
state CellKey a
left CellKey a
right CellKey a
result
ConnectState
-> CellKey a
-> CellKey a
-> CellKey a
-> (a -> a -> Maybe a)
-> Propagator ()
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
left CellKey a
result CellKey a
right (\a
lv a
r -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
divOp a
r a
lv))
ConnectState
-> CellKey a
-> CellKey a
-> CellKey a
-> (a -> a -> Maybe a)
-> Propagator ()
forall a b c.
ConnectState
-> CellKey a
-> CellKey b
-> CellKey c
-> (a -> b -> Maybe c)
-> Propagator ()
combine_ ConnectState
state CellKey a
right CellKey a
result CellKey a
left (\a
rv a
r -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
divOp a
r a
rv))
abs :: Num a => ConnectState -> CellKey a -> CellKey a -> Propagator ()
abs :: forall a.
Num a =>
ConnectState -> CellKey a -> CellKey a -> Propagator ()
abs ConnectState
state CellKey a
left CellKey a
right =
ConnectState
-> CellKey a -> CellKey a -> (a -> Maybe a) -> Propagator ()
forall a b.
ConnectState
-> CellKey a -> CellKey b -> (a -> Maybe b) -> Propagator ()
connect_ ConnectState
state CellKey a
left CellKey a
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 :: Num a => (a -> a) -> ConnectState -> CellKey a -> CellKey a -> Propagator ()
absWith :: forall a.
Num a =>
(a -> a) -> ConnectState -> CellKey a -> CellKey a -> Propagator ()
absWith a -> a
inv ConnectState
state CellKey a
left CellKey a
right = do
ConnectState -> CellKey a -> CellKey a -> Propagator ()
forall a.
Num a =>
ConnectState -> CellKey a -> CellKey a -> Propagator ()
abs ConnectState
state CellKey a
left CellKey a
right
ConnectState
-> CellKey a -> CellKey a -> (a -> Maybe a) -> Propagator ()
forall a b.
ConnectState
-> CellKey a -> CellKey b -> (a -> Maybe b) -> Propagator ()
connect_ ConnectState
state CellKey a
right CellKey a
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 :: Num a => ConnectState -> CellKey a -> CellKey a -> Propagator ()
negate :: forall a.
Num a =>
ConnectState -> CellKey a -> CellKey a -> Propagator ()
negate ConnectState
state CellKey a
left CellKey a
right = do
ConnectState
-> CellKey a -> CellKey a -> (a -> Maybe a) -> Propagator ()
forall a b.
ConnectState
-> CellKey a -> CellKey b -> (a -> Maybe b) -> Propagator ()
connect_ ConnectState
state CellKey a
left CellKey a
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 a -> CellKey a -> (a -> Maybe a) -> Propagator ()
forall a b.
ConnectState
-> CellKey a -> CellKey b -> (a -> Maybe b) -> Propagator ()
connect_ ConnectState
state CellKey a
right CellKey a
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 :: Num a => ConnectState -> CellKey a -> CellKey a -> Propagator ()
signum :: forall a.
Num a =>
ConnectState -> CellKey a -> CellKey a -> Propagator ()
signum ConnectState
state CellKey a
left CellKey a
right =
ConnectState
-> CellKey a -> CellKey a -> (a -> Maybe a) -> Propagator ()
forall a b.
ConnectState
-> CellKey a -> CellKey b -> (a -> Maybe b) -> Propagator ()
connect_ ConnectState
state CellKey a
left CellKey a
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 :: Num a => (a -> a) -> ConnectState -> CellKey a -> CellKey a -> Propagator ()
signumWith :: forall a.
Num a =>
(a -> a) -> ConnectState -> CellKey a -> CellKey a -> Propagator ()
signumWith a -> a
inv ConnectState
state CellKey a
left CellKey a
right = do
ConnectState -> CellKey a -> CellKey a -> Propagator ()
forall a.
Num a =>
ConnectState -> CellKey a -> CellKey a -> Propagator ()
signum ConnectState
state CellKey a
left CellKey a
right
ConnectState
-> CellKey a -> CellKey a -> (a -> Maybe a) -> Propagator ()
forall a b.
ConnectState
-> CellKey a -> CellKey b -> (a -> Maybe b) -> Propagator ()
connect_ ConnectState
state CellKey a
right CellKey a
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)