Of course, you could have the 'interpretation' function be non-pure.

For example:

-- Library functions for a hypothetical FRP system
pollEvent :: IO [a] -> Event a
behavior :: a -> Event a -> Behavior a
accumB :: b -> (b -> a -> b) -> Event a -> Behavior b
accumE :: b -> (b -> a -> b) -> Event a -> Event b
union :: Event a -> Event a -> Event a
runFRP :: (a -> IO Bool) -> Behavior a -> IO ()
-- Event & Behavior become instances of Functor & Applicative

-- and now a hypothetical implementation
data Event a where
   Event :: s -- initial state
               -> (s -> IO ([a], s))  -- tick
               -> Event a
data Behavior a = Behavior a (Event a)

pollEvent act = Event () $ \() -> do
     xs <- act
     return (xs, ())

behavior = Behavior

union (Event sL0 tickL) (Event sR0 tickR) = Event (sL0,sR0) tick where
    tick (sL, sR) = do
        (ls, sL') <- tickL sL
        (rs, sR') <- tickR sR
        return (ls ++ rs, (sL', sR'))

accumB b0 f e = Behavior b0 $ accumE b f e

accumE b0 f (Event s0 tickE) = Event (b0, s0) tick where
    tick (b, s) = do
        (as, s') <- tickE s
        let bs = scanl f b as
        return (bs, (last bs, s'))
      
-- Functor, Applicative instances are pretty easy and left as an exercise

runFRP tick (Behavior b0 (Event s0 e)) = runFRP' b0 s0 where
    runFRP' b s = do
    (bs, s') <- e s0
    let val = last (b:bs)
    k <- tick b
    when k $ runFRP tick (Behavior
   
    k <- tick b
   



-- sample application
keypress :: Event Char
keypress = pollEvent getCurrentPressedKeys where
   getCurrentPressedKeys = undefined -- exercise for the reader




  


On Mon, Apr 25, 2011 at 5:28 PM, Edward Amsden <eca7215@cs.rit.edu> wrote:
As far as I can tell, with classic FRP implementations (those which
use behaviors as a first-class abstraction), the only way to create a
behavior or
event based on some external input (for instance keypresses or
microphone input) is to do something with unsafePerformIO or
unsafeInterleaveIO. A behavior is a value, which when evaluated at a
specific time would have to either block its evaluation until input
could be read, or check the input at that particular time.

Is there any other way of implementing external behaviors besides that?

--
Edward Amsden
Student
Computer Science
Rochester Institute of Technology
www.edwardamsden.com

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe