{-# LANGUAGE GADTs #-}

{-

  A very simple library for manipulating continuous signals.

-}
module SignalDeep
  ( Time
  , Signal  -- the Signal type is abstract
  , ($$), constS, mapS, mapT, sample, timeS
  )
  where

import Control.Applicative

type Time = Double

data Signal a where
  ConstS :: a -> Signal a
  TimeS  :: Signal Time
  MapT   :: (Time -> Time) -> Signal a -> Signal a
  (:$$)  :: Signal (a -> b) -> Signal a -> Signal b

-- | The constant signal.
constS :: a -> Signal a
constS x = ConstS x

-- | The time signal
timeS :: Signal Time
timeS = TimeS

-- | Function application lifted to signals.
($$) :: Signal (a -> b) -> Signal a -> Signal b
fs $$ xs = fs :$$ xs

-- | Transforming the time.
mapT :: (Time -> Time) -> Signal a -> Signal a
mapT = MapT

-- | Sampling a signal at a given time point.
sample :: Signal a -> Time -> a
sample (ConstS x) _ = x
sample TimeS      t = t
sample (f :$$ s)  t = sample f t $ sample s t
sample (MapT f s) t = sample s (f t)

-- | Mapping a function over a signal.
mapS :: (a -> b) -> Signal a -> Signal b
mapS f xs = constS f $$ xs

-- Signal is an applicative functor
instance Functor Signal where
  fmap = mapS

instance Applicative Signal where
  pure  = constS
  (<*>) = ($$)