module Internal.UIItem (
UIItem (UIItem),
item,
Brick,
brick,
just,
Box,
box,
with,
With (With),
Item (type CommonInputOptRecord, type CommonOutputRecord),
Placement,
Widget,
Window,
IsEnabled (IsEnabled)
) 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.Optionality as OptionalityRecord
import Data.Record.Signal as SignalRecord
import Data.Record.Signal.Context as ContextSignalRecord
import FRP.Grapefruit.Setup as Setup
import FRP.Grapefruit.Circuit as Circuit
import FRP.Grapefruit.Signal as Signal
import FRP.Grapefruit.Signal.Segmented as SSignal
import Graphics.UI.Grapefruit.Backend as UIBackend
import Internal.UICircuit as UICircuit
import Internal.Interfacing as Interfacing hiding (with)
import qualified Internal.Interfacing as Interfacing
import Graphics.UI.Grapefruit.Comp as UIComp
infixr 6 `with`
newtype UIItem item uiBackend era i o = UIItem (UICircuit item uiBackend era i o)
instance UIComp UIItem where
circuit |>> UIItem uiCircuit = UIItem (circuit |>> uiCircuit)
UIItem uiCircuit >>| circuit = UIItem (uiCircuit >>| circuit)
loop (UIItem uiCircuit) = UIItem (Arrow.loop uiCircuit)
toUICircuit (UIItem uiCircuit) = uiCircuit
fromUIItem = id
item :: (nativeItem -> IO ())
-> (Placement item uiBackend -> IO nativeItem)
-> Interfacing nativeItem era i o
-> UIItem item uiBackend era i o
item showItem
newItem
(Interfacing interfacingImpl) = UIItem $
UICircuit $ arr id &&& readState >>> liftReader arrow where
arrow = proc (i,placement) -> do
nativeItem <- act -< newItem placement
o <- runReader interfacingImpl -< (i,nativeItem)
_ <- putSetup -< Setup.fromIO $ showItem nativeItem
returnA -< o
newtype Brick item uiBackend iOptRecord oRecord
= Brick (forall era extIRecord extORecord.
(Record SignalKind extIRecord,
Record SignalKind extORecord,
Subrecord extIRecord
(All iOptRecord `Cat` All (CommonInputOptRecord item)),
Subrecord (Required iOptRecord `Cat` Required (CommonInputOptRecord item))
extIRecord,
Subrecord extORecord
(oRecord `Cat` CommonOutputRecord item)) =>
UIItem item uiBackend era (SignalRecord era extIRecord)
(SignalRecord era extORecord))
brick :: (Item item,
OptRecord iOptRecord,
Record SignalKind (All iOptRecord),
Record SignalKind oRecord)
=> ContextConsumerRecord nativeItem (All (CommonInputOptRecord item))
-> ContextProducerRecord nativeItem (CommonOutputRecord item)
-> (nativeItem -> IO ())
-> (Placement item uiBackend -> IO nativeItem)
-> ContextConsumerRecord nativeItem (All iOptRecord)
-> ContextProducerRecord nativeItem oRecord
-> Brick item uiBackend iOptRecord oRecord
brick commonConsumerRecord commonProducerRecord showItem newItem consumerRecord producerRecord
= Brick $ item showItem
newItem
(Interfacing.basic (cat consumerRecord commonConsumerRecord)
(cat producerRecord commonProducerRecord))
just :: (Record SignalKind extIRecord,
Record SignalKind extORecord,
Subrecord extIRecord
(All iOptRecord `Cat` All (CommonInputOptRecord item)),
Subrecord (Required iOptRecord `Cat` Required (CommonInputOptRecord item))
extIRecord,
Subrecord extORecord
(oRecord `Cat` CommonOutputRecord item),
UIComp uiComp)
=> Brick item uiBackend iOptRecord oRecord
-> uiComp item uiBackend era (SignalRecord era extIRecord) (SignalRecord era extORecord)
just (Brick item) = fromUIItem item
newtype Box innerUIComp innerItem item uiBackend iOptRecord oRecord
= Box (forall era extIRecord extORecord innerI innerO.
(Record SignalKind extIRecord,
Record SignalKind extORecord,
Subrecord extIRecord
(All iOptRecord `Cat` All (CommonInputOptRecord item)),
Subrecord (Required iOptRecord `Cat` Required (CommonInputOptRecord item))
extIRecord,
Subrecord extORecord
(oRecord `Cat` CommonOutputRecord item)) =>
innerUIComp innerItem uiBackend era innerI innerO ->
UIItem item uiBackend era (SignalRecord era extIRecord `With` innerI)
(SignalRecord era extORecord `With` innerO))
box :: (UIComp innerUIComp,
Item item,
OptRecord iOptRecord,
Record SignalKind (All iOptRecord),
Record SignalKind oRecord)
=> ContextConsumerRecord nativeItem (All (CommonInputOptRecord item))
-> ContextProducerRecord nativeItem (CommonOutputRecord item)
-> (nativeItem -> IO ())
-> (Placement item uiBackend -> IO nativeItem)
-> (nativeItem -> Placement innerItem uiBackend)
-> ContextConsumerRecord nativeItem (All iOptRecord)
-> ContextProducerRecord nativeItem oRecord
-> Box innerUIComp innerItem item uiBackend iOptRecord oRecord
box commonConsumerRecord commonProducerRecord
showItem
newItem
placement
consumerRecord producerRecord
= Box $ \innerComp -> item showItem
newItem
(Interfacing.with placement innerComp $
Interfacing.basic (cat consumerRecord commonConsumerRecord)
(cat producerRecord commonProducerRecord))
with :: (Record SignalKind extIRecord,
Record SignalKind extORecord,
Subrecord extIRecord
(All iOptRecord `Cat` All (CommonInputOptRecord item)),
Subrecord (Required iOptRecord `Cat` Required (CommonInputOptRecord item))
extIRecord,
Subrecord extORecord
(oRecord `Cat` CommonOutputRecord item),
UIComp uiComp)
=> Box innerUIComp innerItem item uiBackend iOptRecord oRecord
-> innerUIComp innerItem uiBackend era innerI innerO
-> uiComp item uiBackend era (SignalRecord era extIRecord `With` innerI)
(SignalRecord era extORecord `With` innerO)
with (Box item) = fromUIItem . item
class (OptRecord (CommonInputOptRecord item),
Record SignalKind (All (CommonInputOptRecord item)),
Record SignalKind (CommonOutputRecord item)) =>
Item item where
type CommonInputOptRecord item :: * -> *
type CommonOutputRecord item :: * -> *
type family Placement item uiBackend :: *
data Widget
instance Item Widget where
type CommonInputOptRecord Widget = X :& Opt IsEnabled ::: SSignal `Of` Bool
type CommonOutputRecord Widget = X
type instance Placement Widget uiBackend = WidgetPlacement uiBackend
data Window
instance Item Window where
type CommonOutputRecord Window = X
type CommonInputOptRecord Window = X
type instance Placement Window uiBackend = WindowPlacement uiBackend
data IsEnabled = IsEnabled