module FRP.Timeless.Prefab.Primitive
(
mkEmpty
, mkId
, mkConst
, mkPure
, mkGen
, mkPW
, mkPWN
, mkPW_
, mkSW_
, mkPureN
, mkPure_
, mkGenN
, 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.Signal
mkPW :: (Monoid s) => (s -> a -> (b, Signal s m a b)) -> Signal s m a b
mkPW f = mkPure (\ds -> lstrict . first (Just) . (f ds))
mkPWN :: (a -> (b, Signal s m a b)) -> Signal s m a b
mkPWN f = mkPureN $ lstrict . first (Just) . f
mkPW_ :: (a -> b) -> Signal s m a b
mkPW_ = SArr . fmap
mkSW_ :: b -> (b -> a -> b) -> Signal s m a b
mkSW_ b0 f = mkPWN $ g b0
where
g b0 x = let b1 = f b0 x in
(b1, mkSW_ b1 f)
mkEmpty :: Signal s m a b
mkEmpty = SConst Nothing
mkId :: Signal s m a a
mkId = SId
mkConst :: Maybe b -> Signal s m a b
mkConst = SConst
mkPure :: (Monoid s) => (s -> a -> (Maybe b, Signal s m a b)) -> Signal s m a b
mkPure f = go mempty
where
go t0 = SPure $ \ds mx ->
let t = t0 <> ds in
t `seq`
case mx of
Just x -> lstrict (f t x)
Nothing -> (Nothing, go t)
mkPureN :: (a -> (Maybe b, Signal s m a b)) -> Signal s m a b
mkPureN f = go
where
go = SPure $ \_ mx ->
case mx of
Just x -> lstrict (f x)
Nothing -> (Nothing, go)
mkPure_ :: (a -> (Maybe b)) -> Signal s 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, Monoid s) => (s -> a -> m (Maybe b, Signal s m a b)) -> Signal s m a b
mkGen f = go mempty
where
go s0 = SGen $ \ds mx ->
let s = s0 <> ds in
s `seq`
case mx of
Just x -> liftM lstrict (f s x)
Nothing -> return (Nothing, go s)
mkGenN :: (Monad m) => (a -> m (Maybe b, Signal s m a b)) -> Signal s m a b
mkGenN f = go
where
go = SGen $ \_ mx ->
case mx of
Just x -> liftM lstrict (f x)
Nothing -> return (Nothing, go)
mkGen_ :: (Monad m) => (a -> m (Maybe b)) -> Signal s m a b
mkGen_ f = go
where
go = SGen $ \_ mx ->
case mx of
Just x ->
let mmx' = f x in
liftM (lstrict . (, go)) mmx'
Nothing ->
return (Nothing, go)
mkKleisli_ :: (Monad m) => (a -> m b) -> Signal s m a b
mkKleisli_ f = mkGen_ $ \x -> fmap Just (f x)
mkSK_ :: (Monad m) => b -> (b -> a -> m b) -> Signal s m a b
mkSK_ b f = mkGenN $ f'
where
f' a = do
b' <- f b a
return (Just b', mkSK_ b' f)
mkConstM :: (Monad m) => m b -> Signal s m a b
mkConstM b = mkKleisli_ $ \_ -> b
mkActM :: (Monad m) => m b -> Signal s m a b
mkActM = mkConstM
delay :: a -> Signal s m a a
delay x' = mkPWN $ \x -> (x', delay x)