module FRP.Timeless.Internal.Prefab.Primitive
(
mkEmpty
, mkId
, mkConst
, mkPure
, mkGen
, mkPure_
, mkSF
, mkSF_
, mkSW_
, mkGen_
, mkKleisli_
, mkSK_
, mkConstM
, mkActM
, delay
)
where
import Control.Arrow
import Control.Applicative
import Data.Monoid
import Control.Monad
import Control.Monad.IO.Class
import FRP.Timeless.Internal.Signal
mkSF :: (a -> (b, Signal m a b)) -> Signal m a b
mkSF f = mkPure (lstrict . first (Just) . (f))
mkSF_ :: (a -> b) -> Signal m a b
mkSF_ = SArr . fmap
mkSW_ :: b -> (b -> a -> b) -> Signal m a b
mkSW_ b0 f = mkSF $ g b0
where
g b0 x = let b1 = f b0 x in
(b1, mkSW_ b1 f)
mkEmpty :: Signal m a b
mkEmpty = SConst Nothing
mkId :: Signal m a a
mkId = SId
mkConst :: Maybe b -> Signal m a b
mkConst = SConst
mkPure :: (a -> (Maybe b, Signal m a b)) -> Signal m a b
mkPure f = SPure $ \mx ->
case mx of
Just x -> lstrict $ f x
Nothing -> (Nothing, mkPure f)
mkPure_ :: (a -> (Maybe b)) -> Signal m a b
mkPure_ f = go
where
go = SPure $ \mx ->
case mx of
Just x -> lstrict (f x, go)
Nothing -> (Nothing, go)
mkGen :: (Monad m) => (a -> m (Maybe b, Signal m a b)) -> Signal m a b
mkGen f = SGen $ \ mx ->
case mx of
Just x -> liftM lstrict $ f x
Nothing -> return (Nothing, mkGen f)
mkGen_ :: (Monad m) => (a -> m (Maybe b)) -> Signal m a b
mkGen_ f = SGen $ \mx ->
case mx of
Just x ->
let mmx' = f x in
liftM (lstrict . (, mkGen_ f)) mmx'
Nothing ->
return (Nothing, mkGen_ f)
mkKleisli_ :: (Monad m) => (a -> m b) -> Signal m a b
mkKleisli_ f = mkGen_ $ \x -> fmap Just (f x)
mkSK_ :: (Monad m) => b -> (b -> a -> m b) -> Signal m a b
mkSK_ b f = mkGen $ f'
where
f' a = do
b' <- f b a
return (Just b', mkSK_ b' f)
mkConstM :: (Monad m) => m b -> Signal m a b
mkConstM b = mkKleisli_ $ \_ -> b
mkActM :: (Monad m) => m b -> Signal m a b
mkActM = mkConstM
delay :: a -> Signal m a a
delay x' = mkSF $ \x -> (x', delay x)