module Internal.Interfacing (
Interfacing (Interfacing),
basic,
with,
With (With)
) where
import Control.Arrow as Arrow
import Control.Arrow.Operations as ArrowOperations
import Control.Arrow.Transformer.Reader as ReaderArrow
import FRP.Grapefruit.Circuit as Circuit
import FRP.Grapefruit.Record as Record
import FRP.Grapefruit.Record.Context as ContextRecord
import Internal.UIItem as UIItem
import Internal.UICircuit as UICircuit
import Graphics.UI.Grapefruit.Comp as UIComp
infixl 1 `With`
newtype Interfacing nativeItem era i o = Interfacing (ReaderArrow nativeItem (Circuit era) i o)
basic :: (Subrecord extIShape iShape, Subrecord extOShape oShape)
=> ContextConsumerRecord nativeItem iShape
-> ContextProducerRecord nativeItem oShape
-> Interfacing nativeItem era (SignalRecord era extIShape) (SignalRecord era extOShape)
basic consumerRecord producerRecord = Interfacing $
ContextRecord.consume (narrow consumerRecord) >>>
ContextRecord.produce (narrow producerRecord)
inner :: (UIComp uiComp)
=> (nativeItem -> Placement innerItem uiBackend)
-> uiComp innerItem uiBackend era innerI innerO
-> Interfacing nativeItem era innerI innerO
inner placement innerComp = Interfacing $
arr id &&& (readState >>> arr placement) >>>
liftReader (runReader innerArrow) where
UICircuit innerArrow = toUICircuit innerComp
with :: (UIComp uiComp)
=> (nativeItem -> Placement innerItem uiBackend)
-> uiComp innerItem uiBackend era innerI innerO
-> Interfacing nativeItem era baseI baseO
-> Interfacing nativeItem era (baseI `With` innerI) (baseO `With` innerO)
with placement innerComp (Interfacing baseInterfacingImpl) = interfacing' where
interfacing' = Interfacing $
arr fromWith >>>
baseInterfacingImpl *** innerInterfacingImpl >>>
arr toWith
Interfacing innerInterfacingImpl = inner placement innerComp
fromWith (base `With` inner) = (base,inner)
toWith (base,inner) = base `With` inner
data base `With` inner = base `With` inner