module FRP.Grapefruit.Record.Context (
ContextConsumerRecord,
ContextProducerRecord,
ContextConnectorRecord,
ContextConnectorStyle,
consume,
produce,
app,
(:::) ((::~~))
) where
import Control.Arrow.Operations as ArrowOperations
import Control.Arrow.Transformer.Reader as ReaderArrow
import FRP.Grapefruit.Circuit as Circuit
import FRP.Grapefruit.Signal as Signal hiding (consume, produce)
import FRP.Grapefruit.Record as Record hiding (consume, produce)
import qualified FRP.Grapefruit.Record as Record
infixr 0 `app`
infix 3 ::~~
type ContextConsumerRecord context record = ContextConnectorRecord context Consumer record
type ContextProducerRecord context record = ContextConnectorRecord context Producer record
type ContextConnectorRecord context connector record = record (ContextConnectorStyle context
connector)
data ContextConnectorStyle context connector
data instance (:::) name
(signal `Of` val)
(ContextConnectorStyle context
connector) = (::~~) !name
(context -> connector signal val)
consume :: (Record record)
=> ContextConsumerRecord context record
-> ReaderArrow context (Circuit era) (SignalRecord era record) ()
consume = connect Record.consume
produce :: (Record record)
=> ContextProducerRecord context record
-> ReaderArrow context (Circuit era) () (SignalRecord era record)
produce = connect Record.produce
connect :: (Record record)
=> (ConnectorRecord connector record -> Circuit era i o)
-> ContextConnectorRecord context connector record
-> ReaderArrow context (Circuit era) i o
connect signalRecordConnect contextConnectorRecord = arrow' where
arrow' = proc i -> do
context <- readState -< ()
liftReader $ signalRecordConnect (contextConnectorRecord `app` context) -<< i
app :: (Record record)
=> ContextConnectorRecord context connector record
-> context
-> ConnectorRecord connector record
app = case build nilAppThing consAppThing of AppThing apply -> apply
newtype AppThing context connector record = AppThing (ContextConnectorRecord context
connector
record ->
context ->
ConnectorRecord connector record)
nilAppThing :: AppThing context connector X
nilAppThing = AppThing $ \X _ -> X
consAppThing :: AppThing context connector record
-> AppThing context connector (record :& name ::: signal `Of` val)
consAppThing (AppThing apply) = AppThing apply' where
apply' ((:&) contextConnectorRecord
(name ::~~ contextConnector))
context = apply contextConnectorRecord context :&
name ::~ contextConnector context