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 Data.Record as Record
import Data.Record.Signal as SignalRecord
import Data.Record.Signal.Context as ContextSignalRecord
import FRP.Grapefruit.Circuit as Circuit
import Internal.UIItem as UIItem
import Internal.UICircuit as UICircuit
import Graphics.UI.Grapefruit.Comp as UIComp
infixr 1 `With`
newtype Interfacing nativeItem era i o = Interfacing (ReaderArrow nativeItem (Circuit era) i o)
basic :: (Record SignalKind extIShape, Record SignalKind extOShape,
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 $
ContextSignalRecord.consume (narrow consumerRecord) >>>
ContextSignalRecord.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