grapefruit-frp-0.0.0.0: src/FRP/Grapefruit/Signal/Continuous.hs

{-|
    This module is about continuous signals.

    For a general introduction to signals, see the documentation of "FRP.Grapefruit.Signal".
-}
module FRP.Grapefruit.Signal.Continuous (

    -- * Continuous signal type
    CSignal,

    -- * Conversion
    fromSSignal,

    -- * Connectors
    producer

) where

    -- Control
    import Control.Applicative as Applicative
#if __GLASGOW_HASKELL__ >= 610
    import Control.Arrow       as Arrow
#else
    import Control.Arrow       as Arrow   hiding (pure)
#endif
    import Control.Compose     as Compose

    -- Data
    import Data.Unique as Unique

    -- Internal
    import           Internal.Capsule                   as Capsule
    import           Internal.CSeg                      as CSeg    hiding (producer)
    import qualified Internal.CSeg                      as CSeg
    import           Internal.Signal                    as Signal
    import           Internal.Signal.Discrete (DSignal)
    import qualified Internal.Signal.Discrete           as DSignal
    import           Internal.Signal.Segmented          as SSignal

    -- Internal
    import Internal.Circuit as Circuit

    -- * Continuous signal type
    {-|
        The type of continuous signals.

        A continuous signal denotes a mapping from times to values. You can think of @CSignal /era/
        /val/@ as being equivalent to @Time /era/ -> /val/@ where @Time /era/@ is the type of all
        times of the given era.

        Continuous signals are used to describe continuously changing values. They are also used for
        values changing at discrete times if there is no possibility of being notified about such
        changes. If there is a notification mechanism then segemented signals, provided by
        "FRP.Grapefruit.Signal.Segmented", should be used.
    -}
    data CSignal era val = CSignal (Capsule val) !(SSignal era (CSeg val))
    {-
        The strictness annotation ensures that reducing the CSignal reduces the SSignal, thereby
        triggering reading of continous sources the SSignal depends on.
    -}

    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 init) segs' where

            segs' = osfSwitch (segsSignal signal)

        ssfSwitch (SSignal init upd) (CSignal initCap segs) = ssfSwitch sampler segs where

            sampler = polySSignal (fixInitCapForInit init initCap)
                                  (polyTimeIDApp (fixInitCapForUpd <$> upd) <#> segs)

    initCap :: CSignal era val -> Capsule val
    initCap (CSignal initCap _) = initCap

    segsSignal :: SSignal era (forall era'. CSignal era' val)
               -> SSignal era (forall era'. SSignal era' (CSeg val))
    segsSignal = fmap polySegs

    polySegs :: (forall era'. CSignal era' val) -> (forall era'. SSignal era' (CSeg val))
    polySegs signal = segs signal

    segs :: CSignal era' val -> SSignal era' (CSeg val)
    segs (CSignal _ segs) = segs

    polySSignal :: (forall era'. SSignal era' (CSeg val) -> SignalFun era' shape)
                -> DSignal era (forall era'. SSignal era' (CSeg val) -> SignalFun era' shape)
                -> SSignal era (forall era'. SSignal era' (CSeg val) -> SignalFun era' shape)
    polySSignal init upd = SSignal init upd

    fixInitCapForInit :: (forall era'. CSignal era' val -> signalFun era' shape)
                      -> Capsule val
                      -> (forall era'. SSignal era' (CSeg val) -> signalFun era' shape)
    fixInitCapForInit fun initCap segs = fun (CSignal initCap segs)

    fixInitCapForUpd :: (forall era'. CSignal era' val -> signalFun era' shape)
                     -> Unique
                     -> CSeg val
                     -> (forall era'. SSignal era' (CSeg val) -> signalFun era' shape)
    fixInitCapForUpd fun timeID initSeg segs = fun (CSignal (currentValCapsule timeID initSeg) segs)

    polyTimeIDApp :: DSignal era (Unique ->
                                  CSeg val ->
                                  forall era'. SSignal era' (CSeg val) -> SignalFun era' shape)
                  -> DSignal era (CSeg val ->
                                  forall era'. SSignal era' (CSeg val) -> SignalFun era' shape)
    polyTimeIDApp signal = DSignal.timeIDApp signal

    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)

    -- * Conversion
    {-|
        Converts a segmented signal into a continous signal, dropping the information about update
        points.
    -}
    fromSSignal :: SSignal era val -> CSignal era val
    fromSSignal signal@(SSignal init _) = CSignal (pure init) (fmap pure signal)

    -- * Connectors
    {-|
        Converts a value read action into a continuous signal producer.

        The producer @producer /readVal/@ produces a continuous signal whose current value is
        determined by executing @/readVal/@.
    -}
    producer :: IO val -> Producer CSignal val
    producer readVal = Producer $
                       proc _ -> do
                           seg <- CSeg.producer readVal -< ()
                           startTimeID <- getStartTimeID -< ()
                           returnA -< CSignal (currentValCapsule startTimeID seg) (pure seg)