module Control.Wire.Prefab.Sample
(
WDiscrete(..),
keep
)
where
import Control.Arrow
import Control.Wire.Classes
import Control.Wire.Prefab.Simple
import Control.Wire.Types
import Data.AdditiveGroup
class Arrow (>~) => WDiscrete t (>~) | (>~) -> t where
discrete :: Wire e (>~) (t, b) b
instance (AdditiveGroup t, MonadClock t m, Ord t) => WDiscrete t (Kleisli m) where
discrete =
WmGen $ \(int, x) ->
if int <= zeroV
then return (Right x, discrete)
else do
t <- getTime
return (Right x, discrete' t x)
where
discrete' :: t -> b -> Wire e (Kleisli m) (t, b) b
discrete' t0 x0 =
WmGen $ \(int, x) ->
if int > zeroV
then do
t <- getTime
let tt = t0 ^+^ int
return $
if t >= tt
then (Right x, discrete' tt x)
else (Right x0, discrete' t0 x0)
else return (Right x, discrete)
keep :: WirePure (>~) => Wire e (>~) b b
keep = mkPure $ \x -> (Right x, constant x)