{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses,
             FlexibleInstances, TupleSections #-}

module Signal(Signal(..)
             ,Feedback(..)
             ,joinSignal
             ,pureSignal
             ,sys) where

import Control.Applicative
import Control.Monad
import Data


-- Signalnals consist of an initial value and an update equation that
-- produces an output.  It is parameterized by an interpreter Monad m.
data Signal m r o =
  forall s. (Feedback m r s) => Signal { 
    sigInit   :: r s, 
    sigUpdate :: r s -> m (r s, r o)
  }
-- The structure is similar to StateT.  However, the purpose is
-- different.  All state machines are parallel, and state is hidden.


-- Interaction with the state type s is exposed through the Feedback
-- interface, which handles the implementation of state feedback
-- inside the interpretation monad.
class Monad m => Feedback m r s where
  feedback :: r s -> (r s -> m (r s, r t)) -> m (r t)


-- Functor and Applicative instances.
instance Functor r => Functor (Signal m r) where
  fmap f (Signal a0 a) = Signal a0 a' where
    a' s = do
      (s', o) <- a s
      return (s', fmap f o)
instance MRepr m r => Applicative (Signal m r) where
  pure v = pureSignal $ return $ pure v
  (Signal f0 f) <*> (Signal a0 a) = Signal (pair (f0, a0)) fa where
    fa s = do
      let (sf, sa) = unpair s
      (sf', f') <- f sf
      (sa', a') <- a sa
      return (pair (sf', sa'), f' <*> a')

-- Lift Feedback operations over () and (,) used resp. in Applicative
-- pure and <*>.
instance (Monad m, Applicative r) => Feedback m r () where
  feedback s f = do
    (_, o) <- f s
    return $ o
instance (Feedback m r s1, Feedback m r s2) => Feedback m r (s1, s2) where
  feedback i f = undefined
--    let (i1, i2) = unpair i in
--    feedback i1 $ \s1 ->
--    feedback i2 $ \s2 -> undefined

fb2 f i1 i2 s1 s2 = do
  (s', o) <- f $ pair (s1, s2)
  let (s1',s2') = unpair s'
  return $ (s2', pair (s1', o))
  

-- Signal is defined in terms of a monadic language.  pureSignal is a
-- variant of pure, lifting monadic values to Signal.
pureSignal :: (Monad m, Applicative r) => m (r t) -> Signal m r t
pureSignal v = undefined -- Signal (pure ()) $ \_ -> liftM (pure (),) $ liftM pure v


-- Using Applicative to lift monadic operations from the underlying
-- language results in two m types nesting.  This operation flattens
-- the two layers.  Internally:
--
--       (r s -> m (r s, m (r o)))
--    -> (r s -> m (r s, r o))
joinSignal :: (Signal m r (m (r o))) -> (Signal m r o)
joinSignal (Signal f0 f) = (Signal f0 f') where
  f' s = do
    (s', mo) <- f s
    o <- mo
    return (s', o)


-- Construct a signal processor (Signal -> Signal) from a scalar update
-- equation.
sys :: Feedback m r s =>
       s -> (s -> r i -> m (s, r o)) ->
       Signal m r i -> Signal m r o
sys p0 process (Signal i0 input) = Signal o0 output where
  o0 = pair (i0, p0)
  output s = do
    let (si, su) = unpair s
    (si', i') <- input si
    (su', o') <- process su i'
    return $ (pair (si', su'), o')

-- It's probably enough to implement a transpose for (,) and Signal:
sigPair :: Monad m => (Signal m r i, Signal m r i') -> Signal m r (i, i')
sigPair = uncurry $ liftA2 (,)