-- |
-- Module:     FRP.Netwire.Noise
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

module FRP.Netwire.Noise
    ( -- * Noise generators
      noise,
      noiseR,
      wackelkontakt,

      -- * Convenience
      stdNoise,
      stdNoiseR,
      stdWackelkontakt
    )
    where

import Control.Wire
import Prelude hiding ((.), id)
import System.Random


-- | Noise events with the given distance between events.  Use 'hold' or
-- 'holdFor' to generate a staircase.

noise ::
    (HasTime t s, Random b, RandomGen g)
    => t  -- ^ Time period.
    -> g  -- ^ Random number generator.
    -> Wire s e m a (Event b)
noise :: t -> g -> Wire s e m a (Event b)
noise int :: t
int | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [Char] -> g -> Wire s e m a (Event b)
forall a. HasCallStack => [Char] -> a
error "noise: Non-positive interval"
noise int :: t
int = t -> [b] -> Wire s e m a (Event b)
forall t s b e (m :: * -> *) a.
HasTime t s =>
t -> [b] -> Wire s e m a (Event b)
periodicList t
int ([b] -> Wire s e m a (Event b))
-> (g -> [b]) -> g -> Wire s e m a (Event b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. g -> [b]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms


-- | Noise events with the given distance between events.  Noise will be
-- in the given range.  Use 'hold' or 'holdFor' to generate a staircase.

noiseR ::
    (HasTime t s, Random b, RandomGen g)
    => t       -- ^ Step duration.
    -> (b, b)  -- ^ Noise range.
    -> g       -- ^ Random number generator.
    -> Wire s e m a (Event b)
noiseR :: t -> (b, b) -> g -> Wire s e m a (Event b)
noiseR int :: t
int _ | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [Char] -> g -> Wire s e m a (Event b)
forall a. HasCallStack => [Char] -> a
error "noiseR: Non-positive interval"
noiseR int :: t
int r :: (b, b)
r = t -> [b] -> Wire s e m a (Event b)
forall t s b e (m :: * -> *) a.
HasTime t s =>
t -> [b] -> Wire s e m a (Event b)
periodicList t
int ([b] -> Wire s e m a (Event b))
-> (g -> [b]) -> g -> Wire s e m a (Event b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b, b) -> g -> [b]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (b, b)
r


-- | Convenience interface to 'noise' for 'StdGen'.

stdNoise ::
    (HasTime t s, Random b)
    => t    -- ^ Step duration.
    -> Int  -- ^ 'StdGen' seed.
    -> Wire s e m a (Event b)
stdNoise :: t -> Int -> Wire s e m a (Event b)
stdNoise int :: t
int = t -> StdGen -> Wire s e m a (Event b)
forall t s b g e (m :: * -> *) a.
(HasTime t s, Random b, RandomGen g) =>
t -> g -> Wire s e m a (Event b)
noise t
int (StdGen -> Wire s e m a (Event b))
-> (Int -> StdGen) -> Int -> Wire s e m a (Event b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> StdGen
mkStdGen


-- | Convenience interface to 'noiseR' for 'StdGen'.

stdNoiseR ::
    (HasTime t s, Monad m, Random b)
    => t       -- ^ Step duration.
    -> (b, b)  -- ^ Noise range.
    -> Int     -- ^ 'StdGen' seed.
    -> Wire s e m a (Event b)
stdNoiseR :: t -> (b, b) -> Int -> Wire s e m a (Event b)
stdNoiseR int :: t
int r :: (b, b)
r = t -> (b, b) -> StdGen -> Wire s e m a (Event b)
forall t s b g e (m :: * -> *) a.
(HasTime t s, Random b, RandomGen g) =>
t -> (b, b) -> g -> Wire s e m a (Event b)
noiseR t
int (b, b)
r (StdGen -> Wire s e m a (Event b))
-> (Int -> StdGen) -> Int -> Wire s e m a (Event b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> StdGen
mkStdGen


-- | Convenience interface to 'wackelkontakt' for 'StdGen'.

stdWackelkontakt ::
    (HasTime t s, Monad m, Monoid e)
    => t    -- ^ Step duration.
    -> Double    -- ^ Probability to produce.
    -> Int  -- ^ 'StdGen' seed.
    -> Wire s e m a a
stdWackelkontakt :: t -> Double -> Int -> Wire s e m a a
stdWackelkontakt int :: t
int p :: Double
p = t -> Double -> StdGen -> Wire s e m a a
forall t s (m :: * -> *) e g a.
(HasTime t s, Monad m, Monoid e, RandomGen g) =>
t -> Double -> g -> Wire s e m a a
wackelkontakt t
int Double
p (StdGen -> Wire s e m a a)
-> (Int -> StdGen) -> Int -> Wire s e m a a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> StdGen
mkStdGen


-- | Randomly produce or inhibit with the given probability, each time
-- for the given duration.
--
-- The name /Wackelkontakt/ (German for /slack joint/) is a Netwire
-- running gag.  It makes sure that you revisit the documentation from
-- time to time. =)
--
-- * Depends: now.

wackelkontakt ::
    (HasTime t s, Monad m, Monoid e, RandomGen g)
    => t  -- ^ Duration.
    -> Double  -- ^ Probability to produce.
    -> g  -- ^ Random number generator.
    -> Wire s e m a a
wackelkontakt :: t -> Double -> g -> Wire s e m a a
wackelkontakt int :: t
int _ _ | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [Char] -> Wire s e m a a
forall a. HasCallStack => [Char] -> a
error "wackelkontakt: Non-positive duration"
wackelkontakt int :: t
int p :: Double
p g :: g
g = ((Double, a) -> a) -> Wire s e m a (Double, a) -> Wire s e m a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, a) -> a
forall a b. (a, b) -> b
snd (Wire s e m a (Double, a) -> Wire s e m a a)
-> Wire s e m a (Double, a) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ (Double -> Bool) -> Wire s e m Double Double
forall e a s (m :: * -> *).
Monoid e =>
(a -> Bool) -> Wire s e m a a
when (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
p) Wire s e m Double Double
-> Wire s e m a Double -> Wire s e m a Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Wire s e m (Event Double) Double
forall e s (m :: * -> *) a. Monoid e => Wire s e m (Event a) a
hold Wire s e m (Event Double) Double
-> Wire s e m a (Event Double) -> Wire s e m a Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> g -> Wire s e m a (Event Double)
forall t s b g e (m :: * -> *) a.
(HasTime t s, Random b, RandomGen g) =>
t -> g -> Wire s e m a (Event b)
noise t
int g
g Wire s e m a Double -> Wire s e m a a -> Wire s e m a (Double, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Wire s e m a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id