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.Capsule          as Capsule
    import                Internal.Vista (Vista)
    import qualified      Internal.Vista            as Vista
    import                Internal.Signal           as Signal
    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 init) (vista (fmap polyVista upd))

        ssfSwitch (SSignal init upd) arg = signalFun' where

            signalFun'  = switch (SSignal.fromInitAndUpdate reducedInit reducedUpd)

            reducedInit = init (DSignal (vista arg))

            reducedUpd  = DSignal (polyReducedFunUpdate (vista vistaFunUpd) (vista arg))

            vistaFunUpd = vistaFunSignal upd

    instance Sampler DSignal where

        sample = dSample

        samplerMap = fmap

    polyReducedFunUpdate :: Vista (Vista val -> forall era'. SignalFun era' shape)
                         -> Vista val
                         -> Vista (forall era'. SignalFun era' shape)
    polyReducedFunUpdate funUpdVista argVista = Vista.reducedFunUpdate funUpdVista argVista

    vistaFunSignal :: DSignal era (forall era'. DSignal era' val -> SignalFun era' shape)
                   -> DSignal era (Vista val -> forall era'. SignalFun era' shape)
    vistaFunSignal = fmap (\dSignalFun vista -> dSignalFun (DSignal vista))

    vista :: DSignal era val -> Vista val
    vista (DSignal val) = val

    polyVista :: (forall era. DSignal era val) -> Vista val
    polyVista dSignal = vista dSignal

    -- * 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 dSignalVista >>> Vista.consumer handler where

        dSignalVista (DSignal vista) = vista

    {-|
        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