{-# LANGUAGE
    FlexibleContexts,
    UndecidableInstances,
    ExistentialQuantification #-}

import Control.Applicative


-- Try to fit signal/processor composition in a Monad bind operation.
-- Do it in several layers to preserve the "growing" intermedate
-- types.  These will be hidden to implement the final Monad instance.


-- Layer 1: state threading.  

_bind :: (     sa      -> (a, sa)) ->
         (a -> sb      -> (b, sb)) ->
         (     (sa,sb) -> (b, (sa,sb)))
         
_bind ma f = mb where         
  mb (sa, sb) = (b, (sa',sb')) where
    (a, sa') = ma sa
    (b, sb') = f a sb
    
_return :: a -> (() -> (a, ()))    
_return x = \() -> (x, ())    
    

-- Unfold                                 
_run seq init = f init where
  f s = (v : f s') where
    (v, s') = seq s
    
-- Examples, without initial state threading.
_ones = _return 1
_int  = \i s -> let o = i + s in (o,o) 
_ramp1 = _ones `_bind` _int
_ramp2 = _ramp1 `_bind` _int
  

-- Layer 2: initial state building (growing) and passing.

-- This augment the (_bind,_return) monad with initial state building
-- and passing.  This is a bit clumsy.  The initial state is hidden
-- inside the return value of the 2nd argument of __bind, while it is
-- constant in that argument.  I don't see how to do that differently.
  
--         in    state0   state       out state+
---------------------------------------------------  
__bind :: (     (sa,      sa      -> (a,  sa))) ->
          (a -> (sb,      sb      -> (b,  sb))) ->
          (     ((sa,sb), (sa,sb) -> (b,  (sa,sb))))
         
__bind (a0,ma) f = ((a0,b0),mb) where
  -- Get to b0 through a0 -> ma -> f since init state does not depend
  -- on the input.  This is clunky but I don't see another way to get
  -- at it.
  (a, _)  = ma a0
  (b0, _) = f a
  mb = ma `_bind` ((\(_,x) -> x) . f)

__return x = ((), _return x)


-- Unfold
__run (init,seq) = f init where
  f s = (v : f s') where
    (v, s') = seq s



-- Example, with state threading.
__ones = __return 1
__int  = \i -> (0, \s -> let o = i + s in (o,o))
__ramp1 = __ones `__bind` __int
__ramp2 = __ramp1 `__bind` __int

__fmap f m = m `__bind` (\x -> __return $ f x)
__join n   = n `__bind` id

__ap mf ma =  mf `__bind` \f ->
              ma `__bind` \a ->
              __return $ f a


-- Wrap the (__bind, __return) monad in a data type + Monad instance.
-- The existential type hides the "growing" state type.

data Signal a = forall s . Signal (s, (s -> (a, s)))

run (Signal s) = __run s

-- And here it fails.  I can't convince the type system that what I
-- take out of the Signal wrapper can be passed to __bind.  I don't
-- understand why: I did not run into that problem before.

{-
instance Monad Signal where
  return = Signal . __return
  (>>=) (Signal ma) f = Signal $ __bind ma f' where
    f' a = case (f a) of
      (Signal mb) -> mb
-}

-- Creating functor seems not such a big problem.

instance Functor Signal => Applicative Signal where
  pure = Signal . __return
  (<*>) (Signal f) (Signal a) = Signal (__ap f a)

instance Functor Signal where  
  fmap f a = (pure f) <*> a



ones = Signal $ __ones
int  = \i -> Signal (0, \s -> let o = i + s in (o,o))