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

module RSignal(Signal(..)) where


-- Alternative version tied to representations.

import Control.Applicative
import Control.Monad

import Data

data Signal l m r t =
  forall s. (Unfold l m r s) => Signal { 
    sigInit   :: r s, 
    sigUpdate :: r s -> m (r s, r t)
  }

class MRepr m r => Unfold l m r s where
  unfold :: r s -> (r s -> m (r s, r t)) -> m (r (l t))


-- Here, (Signal l m r) is Applicative only if r is applicative, which
-- it is not in the most general cases (e.g. phantom types).  Still it
-- is necessary to lift operations over Signals, so define generalized
-- versions.

pureS :: Unfold l m r a => m (r a) -> Signal l m r a
pureS v = Signal nil $ \_ -> liftM (nil,) v
  
mapS :: (r a -> m (r b)) -> Signal l m r a -> Signal l m r b
mapS f (Signal s u) = Signal s u' where
  u' s = do
    (s', a) <- u s
    b <- f a
    return $ (s', b)

-- Applicative needs a lot of boiler plate as it all needs to be
-- handled inside the representation, requiring a higher order
-- language.
-- appS :: Signal l m r (a -> b) -> Signal l m r a -> Signal l m r b
-- appS (Signal f0 f) (Signal a0 a) = Signal (pair (f0, a0)) b where

-- It seems simpler to define a specialized 2-argument map:

map2S :: (r a -> r b -> m (r c)) ->
         Signal l m r a -> Signal l m r b -> Signal l m r c
map2S f (Signal a0 a) (Signal b0 b) = Signal (cons a0 b0) c where
  c s = do
    let (sa, sb) = uncons s
    (sa', a') <- a sa
    (sb', b') <- b sb
    c' <- f a' b'
    return (cons sa' sb', c')
         

instance MRepr m r => Unfold l m r () where unfold = undefined
instance (Unfold l m r a, Unfold l m r b) => Unfold l m r (a,b) where unfold = undefined