grapefruit-frp-0.1.0.6: src/Internal/Signal/Discrete.hs
{-# LANGUAGE NoImpredicativeTypes #-}
module Internal.Signal.Discrete (
-- * Discrete signal type
DSignal (DSignal),
-- * Empty signal
empty,
-- * Combination
-- ** Union
union,
unionWith,
transUnion,
unions,
unionsWith,
-- ** Difference
difference,
differenceWith,
-- ** Intersection
intersection,
intersectionWith,
-- * Mapping and filtering
map,
filter,
catMaybes,
mapMaybe,
-- * Stateful signals
scan,
scan1,
stateful,
-- * Time IDs and capsules
timeIDApp,
crackCapsules,
-- * Connectors
consumer,
producer
) where
-- Prelude
import Prelude hiding (map, filter)
-- Control
import Control.Arrow as Arrow
import Control.Monad as Monad
-- Data
import Data.Monoid as Monoid
import Data.Unique as Unique
import Data.Map as Map (Map) -- for documentation only
-- Internal
import Internal.Signal as Signal
import Internal.Signal.Discrete.Capsule as Capsule
import Internal.Signal.Discrete.Vista as Vista (Vista)
import qualified Internal.Signal.Discrete.Vista as Vista
import {-# SOURCE #-} Internal.Signal.Segmented as SSignal
-- FRP.Grapefruit
import FRP.Grapefruit.Setup as Setup
import FRP.Grapefruit.Circuit as Circuit
-- * Discrete signal type
{-|
The type of discrete signals.
A discrete signal is a sequence of values assigned to discrete times. A pair of a time and a
corresponding value is called an occurrence. You can think of @DSignal /era/ /val/@ as being
equivalent to @'Map' (Time /era/) /val/@ where @Time /era/@ is the type of all times of
the given era. However, an occurence at the starting time of the era is not possible. In
contrast to 'Map', a discrete signal may cover infinitely many values.
Discrete signals can describe sequences of events. For example, the sequence of all key
presses could be described by a discrete signal of characters. Discrete signals are also
used in conjunction with sampling.
The discrete signal instances of 'Functor' and 'Monoid' provide the following method
definitions:
@
'fmap' = 'map'
'mempty' = 'empty'
'mappend' = 'union'
'mconcat' = 'unions'
@
-}
newtype DSignal era val = DSignal (Vista val)
instance Functor (DSignal era) where
fmap = map
instance Monoid (DSignal era val) where
mempty = empty
mappend = union
instance Signal DSignal where
osfSwitch (SSignal init upd) = DSignal vista' where
vista' = Vista.baseSwitch ((vista . unPolyOSF) init) (vista (fmap (vista . unPolyOSF) upd))
ssfSwitch (SSignal init upd) arg = signalFun' where
signalFun' = polySwitch (SSignal.fromInitAndUpdate reducedInit reducedUpd)
reducedInit = appToVista init (vista arg)
reducedUpd = DSignal (Vista.reducedFunUpdate (vista (fmap appToVista upd)) (vista arg))
instance Sampler DSignal where
sample = dSample
samplerMap = fmap
vista :: DSignal era val -> Vista val
vista (DSignal vista) = vista
appToVista :: PolySSF DSignal val shape -> Vista val -> PolySignalFun shape
appToVista fun vista = PolySignalFun (unPolySSF fun (DSignal vista))
-- * Empty signal
-- |A signal with no occurrences.
empty :: DSignal era val
empty = DSignal Vista.empty
-- * Combination
-- ** Union
{-|
Constructs the left-biased union of two discrete signals.
@union@ is equivalent to @'unionWith' const@.
-}
union :: DSignal era val -> DSignal era val -> DSignal era val
union = unionWith const
{-|
Constructs the union of two discrete signals, combining simultaneously occuring values via
a combining function.
@unionWith@ is equivalent to @'transUnion' id id@.
-}
unionWith :: (val -> val -> val) -> (DSignal era val -> DSignal era val -> DSignal era val)
unionWith = transUnion id id
{-|
Union with conversion and combination.
At each time, a signal @/dSignal1/@ or a signal @/dSignal2/@ has an occurence, the signal
@
transUnion /conv1/ /conv2/ /comb/ /dSignal1/ /dSignal2/
@
has an occurence, too. The value of this occurence is formed as follows:
[@/conv1/ /val1/@]
if @/dSignal1/@ has an occurence of value @/val1/@ and @/dSignal2/@ has no occurence
[@/conv2/ /val2/@]
if @/dSignal2/@ has an occurence of value @/val2/@ and @/dSignal1/@ has no occurence
[@/comb/ /val1/ /val2/@]
if @/dSignal1/@ has an occurence of value @/val1/@ and @/dSignal2/@ has an occurence of
value @/val2/@
-}
transUnion :: (val1 -> val')
-> (val2 -> val')
-> (val1 -> val2 -> val')
-> (DSignal era val1 -> DSignal era val2 -> DSignal era val')
transUnion conv1 conv2 comb (DSignal vista1) (DSignal vista2) = DSignal vista' where
vista' = Vista.transUnion conv1 conv2 comb vista1 vista2
{-|
Repeated left-biased union.
@unions@ is equivalent to @foldl 'union' 'empty'@ and @'unionsWith' const@.
-}
unions :: [DSignal era val] -> DSignal era val
unions = foldl union empty
{-|
Repeated union with a combining function.
@unionsWith /comb/@ is equivalent to @foldl ('unionWith' /comb/) 'empty'@.
-}
unionsWith :: (val -> val -> val) -> [DSignal era val] -> DSignal era val
unionsWith comb = foldl (unionWith comb) empty
-- ** Difference
{-|
Constructs the difference of two discrete signals.
@difference@ is equivalent to @'differenceWith' (\\_ _ -> Nothing)@.
-}
difference :: DSignal era val1 -> DSignal era val2 -> DSignal era val1
difference = differenceWith (const (const Nothing))
{-|
Constructs a kind of difference of two discrete signals where occurences may be modified
instead of being dropped.
At each time, a signal @/dSignal1/@ has an occurence of a value @/val1/@, the signal
@differenceWith /comb/ /dSignal1/ /dSignal/@ has
[an occurence of @/val1/@]
if @/dSignal2/@ has no occurence
[an occurence of @/val'/@]
if @/dSignal2/@ has an occurence of a value @/val2/@ and @/comb/ /val1/ /val2/ = Just
/val'/@
[no occurence]
if @/dSignal2/@ has an occurence of a value @/val2/@ and @/comb/ /val1/ /val2/ =
Nothing@
-}
differenceWith :: (val1 -> val2 -> Maybe val1)
-> (DSignal era val1 -> DSignal era val2 -> DSignal era val1)
differenceWith comb = (catMaybes .) . transUnion Just (const Nothing) comb
-- ** Intersection
{-|
Constructs the left-biased intersection of two discrete signals.
@intersection@ is equivalent to @'intersectionWith' const@.
-}
intersection :: DSignal era val1 -> DSignal era val2 -> DSignal era val1
intersection = intersectionWith const
{-|
Constructs the intersection of two discrete signals, combining values via a combining
function.
-}
intersectionWith :: (val1 -> val2 -> val')
-> (DSignal era val1 -> DSignal era val2 -> DSignal era val')
intersectionWith comb = (catMaybes .) .
transUnion (const Nothing) (const Nothing) ((Just .) . comb)
-- * Mapping and filtering
{-|
Converts each value occuring in a discrete signal by applying a function to it.
-}
map :: (val -> val') -> (DSignal era val -> DSignal era val')
map fun = mapMaybe (Just . fun)
{-|
Drops all occurence of a discrete signal whose values do not fulfill a given predicate.
-}
filter :: (val -> Bool) -> (DSignal era val -> DSignal era val)
filter prd = mapMaybe (\val -> if prd val then Just val else Nothing)
{-|
Converts all occurences with values of the form @Just /val/@ into occurences with value
@/val/@ and drops all occurences with value @Nothing@.
-}
catMaybes :: DSignal era (Maybe val) -> DSignal era val
catMaybes = mapMaybe id
{-|
The combination of 'map' and 'catMaybes'.
@mapMaybe /fun/@ is equivalent to @'catMaybes' . 'map' /fun/@.
-}
mapMaybe :: (val -> Maybe val') -> (DSignal era val -> DSignal era val')
mapMaybe fun (DSignal vista) = DSignal $ Vista.mapMaybe fun vista
-- * Stateful signals
{-|
Accumulates the values of a discrete signal, starting with a given initial value.
Applying @scan /init/ /fun/@ to a discrete signal replaces its occurence values @/val_1/@,
@/val_2/@ and so on by the values @/init/ `/fun/` /val_1/@, @(/init/
`/fun/` /val_1/) `/fun/` /val_2/@ and so on.
-}
scan :: accu -> (accu -> val -> accu) -> (DSignal era val -> DSignal era accu)
scan initAccu trans = stateful initAccu .
fmap (\val currentAccu -> join (,) (trans currentAccu val))
{-|
Accumulates the values of a discrete signal, starting with the first occuring value.
Applying @scan1 /init/ /fun/@ to a discrete signal replaces its occurence values @/val_1/@,
@/val_2/@, @/val_3/@ and so on by the values @/val_1/@, @/val_1/ `/fun/` /val_2/@,
@(/val_1/ `/fun/` /val_2/) `/fun/` /val_3/@ and so on.
-}
scan1 :: (val -> val -> val) -> (DSignal era val -> DSignal era val)
scan1 trans = stateful Nothing . fmap statefulTrans where
statefulTrans val currentAccu = let
nextAccu = maybe val (flip trans val) currentAccu
in (nextAccu,Just nextAccu)
{-|
Constructs a discrete signal by repeatedly applying state transformers.
Applying @stateful /init/@ to a discrete signal replaces its occurence values @/trans_1/@,
@/trans_2/@, @/trans_3/@ and so on by the values @fst . /trans_1/ $ /init/@, @fst .
/trans_2/ $ snd . /trans_1/ $ /init/@, @fst . /trans_3/ $ snd . /trans_2/ $ snd . /trans_1/
$ /init/@ and so on.
-}
stateful :: state -> DSignal era (state -> (val,state)) -> DSignal era val
stateful initState (DSignal transVista) = DSignal $ Vista.stateful initState transVista
-- * Time IDs and capsules
timeIDApp :: DSignal era (Unique -> val) -> DSignal era val
timeIDApp (DSignal vista) = DSignal $ Vista.timeIDApp vista
crackCapsules :: DSignal era (Capsule val) -> DSignal era val
crackCapsules (DSignal vista ) = DSignal $ Vista.crackCapsules vista
-- * Connectors
{-|
Converts an event handler into a discrete signal consumer.
If a discrete signal is consumed with such a consumer, the handler is called at each
occurence with the occuring value as its argument.
-}
consumer :: (val -> IO ()) -> Consumer DSignal val
consumer handler = Consumer (arr vista >>> Vista.consumer handler)
{-|
Converts an event handler registration into a discrete signal producer.
Applying the argument of @producer@ to an event handler has to yield a setup which makes the
handler be called with a certain value everytime the produced signal shall have an
occurence of this value.
-}
producer :: ((val -> IO ()) -> Setup) -> Producer DSignal val
producer reg = Producer $ Vista.producer reg >>> arr DSignal