src/RMCA/Auxiliary/Auxiliary.hs

   1 {-# LANGUAGE Arrows #-}
   2
   3 module RMCA.Auxiliary.Auxiliary where
   4
   5 import Data.Maybe
   6 import FRP.Yampa
   7
   8 -- stepBack contains its previous argument as its output. Because it's
   9 -- hard to define it at time 0, it's wrapped up in a Maybe.
  10 stepBack :: SF a (Maybe a)
  11 stepBack = sscan f (Nothing, Nothing) >>^ snd
  12   where f :: (Maybe a, Maybe a) -> a -> (Maybe a, Maybe a)
  13         f (Nothing,_) x' = (Just x', Nothing)
  14         f (Just x, _) x' = (Just x', Just x)
  15
  16 -- Just like stepBack but the output value is always defined and is
  17 -- equal to the input at time 0.
  18 stepBack' :: SF a a
  19 stepBack' = proc x -> do
  20   x' <- stepBack -< x
  21   returnA -< fromMaybe x x'
  22
  23 -- Throws an Event when the incoming signal change. The Event is
  24 -- tagged with the new value.
  25 onChange :: (Eq a) => SF a (Event a)
  26 onChange = proc x -> do
  27   x' <- stepBack -< x
  28   returnA -< makeEvent x x'
  29
  30 -- Similar to onChange but contains its initial value in the first
  31 -- event.
  32 onChange' :: (Eq a) => SF a (Event a)
  33 onChange' = proc x -> do
  34   x' <- stepBack -< x
  35   returnA -< makeEvent x x'
  36
  37 makeEvent x x'
  38   | isNothing x' = Event x
  39   | otherwise = let x'' = fromJust x' in
  40                   if x'' == x then NoEvent else Event x
  41
  42 discard :: a -> ()
  43 discard _ = ()
  44
  45 bound :: (Ord a) => (a, a) -> a -> a
  46 bound (min, max) x
  47   | x < min = min
  48   | x > max = max
  49   | otherwise = x