module Internal.UICircuit (
UICircuit (UICircuit),
fromCircuit,
run
) where
import Prelude hiding ((.))
#if __GLASGOW_HASKELL__ >= 610
import Control.Category as Category hiding (id)
import qualified Control.Category as Category
#endif
import Control.Arrow as Arrow
import Control.Arrow.Transformer.Reader as ReaderArrow
import FRP.Grapefruit.Circuit as Circuit
import FRP.Grapefruit.Signal as Signal
import FRP.Grapefruit.Signal.Discrete as DSignal
import Internal.UIItem as UIItem
import Graphics.UI.Grapefruit.Backend as UIBackend
import Graphics.UI.Grapefruit.Comp as UIComp
newtype UICircuit item uiBackend era i o = UICircuit (ReaderArrow (Placement item uiBackend)
(Circuit era)
i
o)
#if __GLASGOW_HASKELL__ >= 610
instance Category (UICircuit item uiBackend era) where
id = UICircuit Category.id
UICircuit arrow1 . UICircuit arrow2 = UICircuit (arrow1 . arrow2)
#endif
instance Arrow (UICircuit item uiBackend era) where
arr fun = UICircuit (arr fun)
#if __GLASGOW_HASKELL__ < 610
UICircuit arrow1 >>> UICircuit arrow2 = UICircuit (arrow1 >>> arrow2)
#endif
first (UICircuit arrow) = UICircuit (first arrow)
second (UICircuit arrow) = UICircuit (second arrow)
UICircuit arrow1 *** UICircuit arrow2 = UICircuit (arrow1 *** arrow2)
UICircuit arrow1 &&& UICircuit arrow2 = UICircuit (arrow1 &&& arrow2)
instance ArrowLoop (UICircuit item uiBackend era) where
loop (UICircuit arrow) = UICircuit (Arrow.loop arrow)
instance UIComp UICircuit where
circuit |>> uiCircuit = fromCircuit circuit >>> uiCircuit
uiCircuit >>| circuit = uiCircuit >>> fromCircuit circuit
loop = Arrow.loop
toUICircuit = id
fromUIItem (UIItem uiCircuit) = uiCircuit
fromCircuit :: Circuit era i o -> UICircuit item uiBackend era i o
fromCircuit = liftReader >>> UICircuit
run :: (UIBackend uiBackend) =>
uiBackend -> (forall era. UICircuit Window uiBackend era () (DSignal era ())) -> IO ()
run uiBackend uiCircuit = run where
run = do
UIBackend.initialize uiBackend
(_,finalizeCircuit) <- Circuit.create circuit ()
UIBackend.handleEvents uiBackend
finalizeCircuit
UIBackend.finalize uiBackend
circuit = proc _ -> do
quittingReq <- runReader $
case uiCircuit of UICircuit arrow -> arrow
-< ((),topLevel uiBackend)
consume $ DSignal.consumer (const (requestQuitting uiBackend)) -< quittingReq