\begin{code}
module ListenerPrim (module ListenerPrim,Remover)where
import Maybe
import BaseTypes
import MutSet (Remover)
import IOExts
import FranTime
import Monad (when)
import Array
\end{code}

A Listener is a consumer of values. It takes a value occurrence and performs 
an action with it.

   The basic operations are to make a listener (mkLOcc), 
   and tell a listener about a value occurrence (tellOcc)

   Conceptually of type Listener a = a -> IO () (or Occ a -> IO ()).

   This is not powerful enough for what we want.
   There are 3 features we must support:

   1 The first of these classes includes any listener that should only 
     perform an action a given number of times. This includes onceL.
     Fix this by giving the listener an unsubscribe function to use.
     type Listener a = Remover -> (a -> IO ())

   2 The second class of listener combinator includes scanlL. Recall that 
     scanlL is a listener equivalent of the scanl function. The listener's 
     current values starts with the initial value provided. Every time
     the listener consumes a value, it applies its update function to its 
     current argument and the new value. It then uses the result to update 
     its current value, and passes it to the argument listener.
     This form of listener therefore has some implicit state, a current value. 
     We need to create this implicit state before the listener is applied for
     the first time. We can do by wrapping the Listener in an IO action. 
     This allows it to make some local state first.
     type Listener a = IO (a -> IO ()) 

   3 The third class involves a switching listener. Here it is important that 
     a listener can both create some internal state, and return a remove 
     action that should be performed by any enclosing listeners when
     unsubscribing.

\begin{code}

type Listener' a = Occ a -> IO ()
type Occ a = (Time,a)
data Listener a = Listener (Remover ->IO (Remover,Listener' a))
                | NeverL


instance Show (Listener a) where
 show a = "<Listener>"

\end{code}

The primitive ops

\begin{code}
mkPrimL :: (Remover -> IO (Remover,Listener' a)) -> Listener a
mkPrimL f = Listener f

getPrimListener :: Listener a -> Remover->IO (Remover,Listener' a)
getPrimListener (Listener mk) rm = mk rm
getPrimListener NeverL rm = return (return (),const (return ()))

-- a listener that does nothing

neverL :: Listener a
neverL = NeverL

isNeverL :: Listener a -> Bool
isNeverL NeverL = True
isNeverL _ = False
\end{code}


Ignoring the returned remover

\begin{code}
mkL' :: (Remover -> IO (Listener' a)) -> Listener a
mkL' f = mkPrimL $ \rm -> do {op <- f rm;return (return (),op)}

getListener' :: Listener a -> Remover -> IO (Listener' a)
getListener' l rm = fmap snd $ getPrimListener l rm
\end{code}

Composition functions for Listeners

\begin{code}
liftL1 :: (Listener' a -> Listener' b) -> Listener a -> Listener b
liftL1 _ l | isNeverL l = neverL
liftL1 f l = mkPrimL $ \rm -> do
 {(rm',op1) <- getPrimListener l rm;return (rm',f op1)}

liftL2 :: (Listener' a -> Listener' b -> Listener' c)
       -> Listener a -> Listener b -> Listener c
liftL2 f l1 l2 = mkPrimL $ \rm -> do
  {(rm1,op1) <- getPrimListener l1 rm;
   (rm2,op2) <- getPrimListener l2 rm;
   return (rm1 >> rm2,f op1 op2)}

liftLIO :: (Remover -> Listener' a -> IO (Listener' b))
       -> Listener a -> Listener b
liftLIO _ l | isNeverL l = neverL
liftLIO f l = mkPrimL $ \rm -> do
  (rm1,op) <- getPrimListener l rm
  op <- f (rm >> rm1) op
  return (rm1,op)
\end{code}



Efficient routing. Make a single listener talk that talks to a given array 
of listeners, depending on the value sent.

\begin{code}
arrayL :: Ix a => (a,a) -> Array a (Listener b) -> Listener (a,b)
arrayL bnds arr = mkL' $ \rm -> do
 let call (i,l) = do op <- getListener' l rm
                     return (i,op)
 arr <- fmap (array bnds) $ sequence ([call (i, arr!i) | i <- indices arr]) 
 let f (t,(a,b)) = do
       (arr ! a) (t,b)
 return f
\end{code}


From a listener, get the listener action.
If we need to fire a listener manually we can achieve this via getListener.
This provides the listener via an IO action. It creates a mutable variable 
that will contain the listener's callback action.
When we create the callback action, we pass in a remove action that 
sets the variable to contain a null action. To talk to the listener we 
read the contents of the variable, and apply the current action to the
occurrence. Clearly this will do nothing when the listener has been removed.

\begin{code}
getListener :: Listener a -> IO (Occ a -> IO ())
getListener l | isNeverL l = return (const (return ()))
getListener l = fmap snd $ fixIO $ \ ~(rm,_) -> do
 op <- getListener' l rm
 ref <- newIORef op
 let kill = writeIORef ref (const (return ())) 
 let tell occ = do {act <- readIORef ref;act occ}
 return (kill,tell)
\end{code}
