-- |
-- 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 :: 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 | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [Char] -> g -> Wire s e m a (Event b)
forall a. HasCallStack => [Char] -> a
error [Char]
"noise: Non-positive interval"
noise 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 :: 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)
_ | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [Char] -> g -> Wire s e m a (Event b)
forall a. HasCallStack => [Char] -> a
error [Char]
"noiseR: Non-positive interval"
noiseR t
int (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 :: forall t s b e (m :: * -> *) a.
(HasTime t s, Random b) =>
t -> Int -> Wire s e m a (Event b)
stdNoise 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 :: forall t s (m :: * -> *) b e a.
(HasTime t s, Monad m, Random b) =>
t -> (b, b) -> Int -> Wire s e m a (Event b)
stdNoiseR t
int (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 :: forall t s (m :: * -> *) e a.
(HasTime t s, Monad m, Monoid e) =>
t -> Double -> Int -> Wire s e m a a
stdWackelkontakt t
int 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 :: 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
_ g
_ | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [Char] -> Wire s e m a a
forall a. HasCallStack => [Char] -> a
error [Char]
"wackelkontakt: Non-positive duration"
wackelkontakt t
int Double
p 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