Sample.hs

-- |
-- Module:     Control.Wire.Prefab.Sample
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Signal sampling wires.

module Control.Wire.Prefab.Sample
    ( -- * Simple samplers
      WDiscrete(..),
      keep
    )
    where

import Control.Arrow
import Control.Wire.Classes
import Control.Wire.Prefab.Simple
import Control.Wire.Types
import Data.AdditiveGroup


-- | Sample the right signal at discrete intervals given by the left
-- input signal.
--
-- * Depends: Current instant (left), last sampling instant (right).

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 the signal in the first instant forever.
--
-- * Depends: First instant.

keep :: WirePure (>~) => Wire e (>~) b b
keep = mkPure $ \x -> (Right x, constant x)