module BehaviorIO where
import FranPrim
import Array
import EventPrim
import IOExts (unsafePerformIO,newIORef,readIORef,writeIORef)
import BPrim (cachingBehavior)


infixr 1 `mkSwitcher`

class SwitchableM bv m where
  mkSwitcher    :: bv -> Event bv -> m bv


instance SwitchableM (Event a) IO where
  mkSwitcher a e = switcherE a e

instance SwitchableM (Behavior a) IO where
  mkSwitcher = switcherB

------ Generalized behaviors 

class IfBehavior bv where
  ifB		:: Behavior Bool -> bv -> bv -> bv

-- turn a behavior into a stream of events. An event occurs, every time
-- the value of the behavior changes...
-- we're using the helper workpool, not the main workpool (See WorkPool.hs)

toStream :: Behavior a -> IO (Event a)
toStream b = toStream' addListenerPredB b
 
toStream' :: (Behavior a -> Listener a -> IO Remover) 
	  -> Behavior a -> IO (Event a)
toStream' add b =  do
 (Wire l e) <- newWire
 add b l
 return e

predicateB :: Behavior Bool -> IO (Event ())
predicateB b = fmap (flip suchThat_ id) $ 
		toStream' (\b -> addLazyLB (addListenerPredB b)) b

instance IfBehavior (Event a) where
  ifB = condE

instance IfBehavior (Behavior a) where
  ifB = condB

-- Count the number of event occurrences

countE :: Event a -> IO (Behavior Int)
countE e = stepAccum 0 (e -=> (+ 1))


-- Flattening behaviors
joinB :: Behavior (Behavior a) -> Behavior a
joinB bh = unsafePerformIO $ do
 let sample' t = do
       (bh1,const) <- sample bh t
       (v,const2) <- sample bh1 t
       return (v,const && const2)
 e <- toStream bh
 invE' <- cacheIO $ (e -=> () .|.
		        (invalidateEv bh `switcherE'` (e ==> invalidateEv)))
 return (cachingBehavior sample' invE')



 -- lazily adding a listener to a behavior, for toStream.
 -- We add a listener to the franTick event, that will be performed once.
 -- On the first occurence, we add a listener to the behavior that fires 
 -- the new event's listener when it receives a value of True. 

 -- This all works sensibly providing that franTick and the toStream workpool
 -- are run with the following semantics.
 -- Whenever we fire the franTick event, we next run the toStream workpool.
 -- AND we run these two with the same occurrence time, without running any 
 -- delayed events between them!!!

addLazyLB :: (Listener a -> IO Remover) -> Listener a  -> IO Remover
addLazyLB add l = do
  remRef <- newIORef Nothing
  rmTmp <- addListener franTick $! mkL_ $ do
		   mb <- readIORef remRef
		   maybe (return ()) 
			 (\rm -> rm >> add l >>= writeIORef remRef . Just) 
			 mb
  writeIORef remRef $! Just rmTmp
  return (callMbRemover remRef Nothing)
