module FRP.Grapefruit.Signal.Continuous (
CSignal,
fromSSignal,
producer
) where
import Control.Applicative as Applicative
import Control.Arrow as Arrow
import Control.Compose as Compose
import Data.Unique as Unique
import Internal.Signal as Signal
import Internal.Signal.Continuous.Segment as CSeg hiding (producer)
import qualified Internal.Signal.Continuous.Segment as CSeg
import Internal.Signal.Discrete.Capsule as Capsule
import Internal.Signal.Discrete as DSignal (DSignal)
import qualified Internal.Signal.Discrete as DSignal
import Internal.Signal.Segmented as SSignal hiding (producer)
import Internal.Circuit as Circuit
data CSignal era val = CSignal (Capsule val) !(SSignal era (CSeg val))
instance Functor (CSignal era) where
fmap fun (CSignal initCap segs) = CSignal (fmap fun initCap) ((fmap . fmap) fun segs)
instance Applicative (CSignal era) where
pure val = CSignal (pure val) ((pure . pure) val)
CSignal funInitCap funSegs <*> CSignal argInitCap argSegs = CSignal initCap' segs' where
initCap' = funInitCap <*> argInitCap
segs' = liftA2 (<*>) funSegs argSegs
instance Signal CSignal where
osfSwitch signal@(SSignal init _) = CSignal ((initCap . unPolyOSF) init) segs' where
segs' = osfSwitch (segsSignal signal)
ssfSwitch (SSignal init upd) (CSignal initCap segs) = ssfSwitch sampler segs where
sampler = SSignal (fixInitCapForInit init initCap)
(DSignal.timeIDApp (fixInitCapForUpd <$> upd) <#> segs)
initCap :: CSignal era val -> Capsule val
initCap (CSignal initCap _) = initCap
segsSignal :: SSignal era (PolyOSF CSignal val)
-> SSignal era (PolyOSF SSignal (CSeg val))
segsSignal = fmap (\polyOSF -> PolyOSF (segs (unPolyOSF polyOSF)))
segs :: CSignal era' val -> SSignal era' (CSeg val)
segs (CSignal _ segs) = segs
fixInitCapForInit :: PolySSF CSignal val shape -> Capsule val -> PolySSF SSignal (CSeg val) shape
fixInitCapForInit fun initCap = PolySSF (\segs -> unPolySSF fun (CSignal initCap segs))
fixInitCapForUpd :: PolySSF CSignal val shape
-> Unique
-> CSeg val
-> PolySSF SSignal (CSeg val) shape
fixInitCapForUpd fun timeID initSeg = result where
result = PolySSF (\segs -> unPolySSF fun (CSignal (currentValCapsule timeID initSeg) segs))
instance Samplee CSignal where
dSample sampler (CSignal _ segs) = (DSignal.crackCapsules . DSignal.timeIDApp) $
timeIDToCapsule <$> sampler <#> segs where
timeIDToCapsule fun seg = fmap fun . flip currentValCapsule seg
sSample (SSignal samplerInit samplerUpd) signal@(CSignal (Capsule init) _) = signal' where
signal' = SSignal (samplerInit init) (samplerUpd <#> signal)
fromSSignal :: SSignal era val -> CSignal era val
fromSSignal signal@(SSignal init _) = CSignal (pure init) (fmap pure signal)
producer :: IO val -> Producer CSignal val
producer readVal = Producer $
proc _ -> do
seg <- CSeg.producer readVal -< ()
startTimeID <- getStartTimeID -< ()
returnA -< CSignal (currentValCapsule startTimeID seg) (pure seg)