\begin{code}
module GFRP where
import FRPWrap
import GUI
import Conf
import WH
import MapG
import Array
import Monad
import Identify

type GEvent a = GUI (Event a)
type GBehavior a = GUI (Behavior a)
\end{code}

Event functions

\begin{code}
neverGE :: GEvent a
neverGE = return  neverE

mapGE :: (a -> b) -> GEvent a -> GEvent b
mapGE f = liftM $ mapE f

filterGE :: (a -> Bool) -> GEvent a -> GEvent a
filterGE p ge = ge >>= return . filterE p

mapMaybeGE :: (a -> Maybe b) -> GEvent a -> GEvent b
mapMaybeGE p ge = ge >>= return . mapMaybeE p

withTimeGE :: GEvent a -> GEvent (a,Time)
withTimeGE ge = ge >>= return . withTimeE

afterTimeGE :: GEvent a -> Time -> GEvent a
afterTimeGE g t = g >>= return . flip afterTimeE t

mapGEs :: (a -> [b]) -> GEvent a -> GEvent b
mapGEs f g = g >>= return . mapEs f 

fromListGE :: GEvent [a] -> GEvent a
fromListGE g = g >>= return . fromListE

traceGE :: Show a => GEvent a -> String -> GEvent a
traceGE g s = g >>= return . flip traceE s

mergeGE :: GEvent a -> GEvent a -> GEvent a
mergeGE g1 g2 = do {e1 <- g1;e2 <- g2;return $ mergeE e1 e2}

arrayGE :: Ix a => (a,a) -> GEvent (a,b) -> GUI (Array a (GEvent b))
arrayGE a g = do {e <- g;
	 	  return $ 
		    fmap return $
		    arrayE a e}

onceGE :: GEvent a -> GEvent a
onceGE me = me >>= onceE

scanlGE :: (a -> b -> a) -> a -> GEvent b -> GEvent a
scanlGE f a e = e >>= scanlE f a

distinctGEWith :: (a -> a -> Bool) -> (a -> Bool) -> GEvent a -> GEvent a
distinctGEWith f p ge = ge >>= distinctEWith f p

accumGE :: a -> GEvent (a -> a) -> GEvent a
accumGE a ge = ge >>= accumE a 

withElemGE :: GEvent a -> [b] -> GEvent (a,b)
withElemGE g bs = g >>= flip withElemE bs

switcherGE :: GEvent a -> GEvent (GEvent a) -> GEvent a
switcherGE g ge = do
 e <- g
 ee' <- ge
 ee <- mapG id ee'
 switcherE e ee

manyGE ::  GEvent a -> GEvent (GEvent a) -> GEvent a
manyGE g ge = do 
 e <- g
 ee' <- ge
 ee <- mapG id ee'
 manyE e ee

distinctGE :: Eq a => GEvent a -> GEvent a
distinctGE ge = ge >>= distinctE

withElemGE_ :: GEvent a -> [b] -> GEvent b
withElemGE_ ge bs = ge >>= flip withElemE_ bs 

withPrevGE :: GEvent a -> a -> GEvent (a,a)
withPrevGE ge a = ge >>= flip withPrevE a

withPrevGE_ :: GEvent a -> a -> GEvent a
withPrevGE_ ge a = ge >>= flip withPrevE_ a

bindOneGE :: GEvent a -> (a -> GEvent b) -> GEvent b
bindOneGE ev f = neverGE `switcherGE` mapGE f ev

bindManyGE :: GEvent a -> (a -> GEvent b) -> GEvent b
bindManyGE ev f = neverGE `manyGE` mapGE f ev

addListenerG :: GEvent a -> Listener a -> GUI (GUI ())
addListenerG ge l = ge >>= flip addListener l
\end{code}

Behavior functions

\begin{code}

constantGB :: a -> GBehavior a
constantGB a = return $ constantB a

liftG1 :: (a -> b) -> GBehavior a -> GBehavior b
liftG1 f g = fmap (lift1 f) g

liftG0                        = constantB
liftG2 f b1 b2                = liftG1 f b1 `gbapp` b2
liftG3 f b1 b2 b3             = liftG2 f b1 b2 `gbapp` b3
liftG4 f b1 b2 b3 b4          = liftG3 f b1 b2 b3 `gbapp` b4
liftG5 f b1 b2 b3 b4 b5       = liftG4 f b1 b2 b3 b4 `gbapp` b5
liftG6 f b1 b2 b3 b4 b5 b6    = liftG5 f b1 b2 b3 b4 b5 `gbapp` b6
liftG7 f b1 b2 b3 b4 b5 b6 b7 = liftG6 f b1 b2 b3 b4 b5 b6 `gbapp` b7
liftG8 f b1 b2 b3 b4 b5 b6 b7 b8 = liftG7 f b1 b2 b3 b4 b5 b6 b7 `gbapp` b8
liftG9 f b1 b2 b3 b4 b5 b6 b7 b8 b9 = liftG8 f b1 b2 b3 b4 b5 b6 b7 b8 `gbapp` b9

snapshotGE :: GEvent a -> GBehavior b -> GEvent (a,b)
snapshotGE e b = liftM2 snapshotE e b

gbapp :: GBehavior (a -> b) -> GBehavior a -> GBehavior b
gbapp gf gb = do {f <- gf;b <- gb;return $ f $* b}


predicateGB :: GBehavior Bool -> GEvent ()
predicateGB g = g >>= predicateB 

countGE :: GEvent a -> GBehavior Int
countGE g = g >>= countE 

switcherGB :: GBehavior a -> GEvent (GBehavior a) -> GBehavior a
switcherGB g ge = do {b <- g;
		      e' <- ge;
		      e <- mapG id e';
		      switcherB b e}

stepperGB :: a -> GEvent a -> GBehavior a
stepperGB a ge = ge >>= stepper a

stepAccumGB :: a -> GEvent (a -> a) -> GBehavior a
stepAccumGB a ge = ge >>= stepAccum a

\end{code}

Use this stuff

\begin{code}

(=:) :: WidgetItem w => (Behavior a -> Conf w) -> GBehavior a -> Conf w
f =: g = 
  case f (error "GFRP := should not be evaluated") of
   (Conf cs) -> 
    let nms = zip cs [1..]
    in
    Conf $ map conf nms
 where
  conf (n,x) = 
   ConfGUI (identify n) $ \w -> do
             b <- g
             case f b of
              (Conf cs) -> 
                csetB w [Conf $ [cs !! x]]
\end{code}
