module Data.Record.Signal (
SignalKind,
Forall (SignalForall),
SignalRecord,
SignalStyle,
ConsumerRecord,
ProducerRecord,
ConnectorRecord,
ConnectorStyle,
consume,
produce
) where
import Control.Arrow as Arrow
import Data.Record as Record
import FRP.Grapefruit.Circuit as Circuit
import FRP.Grapefruit.Signal as Signal (Of, Consumer, Producer)
import qualified FRP.Grapefruit.Signal as Signal
data SignalKind
instance Kind SignalKind where
data Forall SignalKind func = SignalForall (forall signal val. func (signal `Of` val))
encase piece = SignalForall piece
instance Sort SignalKind (signal `Of` val) where
specialize (SignalForall piece) = piece
type SignalRecord era record = record (SignalStyle era)
data SignalStyle era
instance Style (SignalStyle era) where
type K (SignalStyle era) = SignalKind
type instance Value (SignalStyle era) (signal `Of` val) = signal era val
type ConsumerRecord record = ConnectorRecord Consumer record
type ProducerRecord record = ConnectorRecord Producer record
type ConnectorRecord connector record = record (ConnectorStyle connector)
data ConnectorStyle (connector :: (* -> * -> *) -> * -> *)
instance Style (ConnectorStyle connector) where
type K (ConnectorStyle connector) = SignalKind
type instance Value (ConnectorStyle connector) (signal `Of` val) = connector signal val
consume :: (Record SignalKind record) =>
ConsumerRecord record -> Circuit era (SignalRecord era record) ()
consume = case build nilConsumeThing consumeExtender of ConsumeThing result -> result
newtype ConsumeThing era record = ConsumeThing (ConsumerRecord record ->
Circuit era (SignalRecord era record) ())
nilConsumeThing :: ConsumeThing era X
nilConsumeThing = ConsumeThing $ \X -> arr (\X -> ())
consumeExtender :: Forall SignalKind (ExtenderPiece (ConsumeThing era) record name)
consumeExtender = SignalForall (ExtenderPiece consConsumeThing)
consConsumeThing :: forall era record name signal val.
ConsumeThing era record
-> ConsumeThing era (record :& name ::: signal `Of` val)
consConsumeThing (ConsumeThing consume) = ConsumeThing consume' where
consume' :: ConsumerRecord (record :& name ::: signal `Of` val)
-> Circuit era (SignalRecord era (record :& name ::: signal `Of` val)) ()
consume' (consumerRecord :& _ := consumer) = proc (signalRecord :& _ := signal) -> do
consume consumerRecord -< signalRecord
Signal.consume consumer -< signal
produce :: (Record SignalKind record) =>
ProducerRecord record -> Circuit era () (SignalRecord era record)
produce = case build nilProduceThing produceExtender of ProduceThing result -> result
newtype ProduceThing era record = ProduceThing (ProducerRecord record ->
Circuit era () (SignalRecord era record))
nilProduceThing :: ProduceThing era X
nilProduceThing = ProduceThing $ \X -> arr (const X)
produceExtender :: Forall SignalKind (ExtenderPiece (ProduceThing era) record name)
produceExtender = SignalForall (ExtenderPiece consProduceThing)
consProduceThing :: forall era record name signal val.
ProduceThing era record
-> ProduceThing era (record :& name ::: signal `Of` val)
consProduceThing (ProduceThing produce) = ProduceThing produce' where
produce' :: ProducerRecord (record :& name ::: signal `Of` val)
-> Circuit era () (SignalRecord era (record :& name ::: signal `Of` val))
produce' (producerRecord :& name := producer) = proc _ -> do
signalRecord <- produce producerRecord -< ()
signal <- Signal.produce producer -< ()
returnA -< signalRecord :& name := signal