Yampa defines functional reactive programs and a basic 'reactimate' event loop, but comes up short-handed on a rich set of input / output gizmos to play with.  Where's the fun of programming a robot if you can't see the result?

  Enter games - just draw a sprite, simulate some physics and feel the Holiday cheer.  I tried compiling YFrob, but GHC7.4.1 couldn't compile the HGL library dependency for graphics, so I went investigating...

  Gerold Meisinger worked on just this problem, trying to build games on top of Yampa, and was kind enough to blog about it.  Unfortunately, the critical code examples, e.g. 'Yampa/SDL program stub' at appears to be missing, and the code for 'Robotroannah' was never posted.  The second may be understandable, since the game-development world is traditionally further from the open-source model, BUT both Yampa and the Haskell bindings to SDL were opensource, so releasing a stub connecting the two is not unreasonable.

  SDL actually makes a good example of a wrapped library, since it's clear what all those ... -> IO() (writers) and ... -> IO(stuff)
(readers) are doing, while no Ctypes are visible.

  Looking at the structure of Yampa's reactimate loop is critical for understanding how to piece together a working IO loop.
    (note: although this was kicked off by Gerold Meisinger, the whole
     discussion was later contributed by `Laeg', demonstrating how
     open-sourcing just a few bits of insight can lead someone else
     down the road to build something much better)
Essentially, you need to spend some time coding the 'sense' and 'activate' functions that will feed into and act upon the wisdom decreed by your soon-to-be Yampa (SF -> SF) oracle.

A few working examples also help:
1. the animate function on line 85 of YFrob-0.4/src/FRP/YFrob/RobotSim/
-- in fact, this example would have saved me a lot of time
   if I had found it first, and not run into a bug compiling HGL.
2. cuboid-0.14.1/Main.hs -- a simple start to a Yampa/OpenGL game.
Also, the most detailed explanation is given in the comments
above the reactimate function in

  The conclusion is that to make the IO loop work, you need callbacks.

A REPL shell using Haskell + Yampa

Now, let's get something working.  The incremental path is to (work toward a programming language interpreter and) use GNU readline.

  A very simple IO loop, a read-eval-print loop (REPL), can be coded in the top-level IO monad without Yampa, so now there's an entry barrier.  On top of that, it's not clear how to make 'a line was read' into a callback unless I start getting crafty with Concurrent Haskell!
-- I had looked at this earlier, but started to hope that connecting multiple programs via the IO monad (with FRP brains?) would be easier.

Defines an `interactive' shell, but uses Haskell's standard getLine call, with a blocking evaluation, then print, loop that doesn't use FRP.

  Happily, readline provides a callback interface for times when 'applications need to interleave keyboard I/O with file, device, or window system I/O'.
It's not well documented in haskell, but readline says:

  Function: void rl_callback_handler_install (const char *prompt, rl_vcpfunc_t *lhandler)
    Set up the terminal for readline I/O and display the initial expanded
  value of prompt. Save the value of lhandler to use as a function to call when
  a complete line of input has been entered. The function takes the text of the
  line as an argument.

And hackage has:
callbackHandlerInstall :: String -> (String -> IO ()) -> IO (IO ())
The return of an IO() is a little cryptic here, but a glance at the source (I'm starting to appreciate Haddock) shows that the returned IO action is a cleanup routine that removes the handler.

So let's try it out:
-- test_rl.hs
import System.IO
import System.Console.Readline
import Data.IORef
import Control.Concurrent (threadDelay)
import Control.Concurrent.MVar

-- Picked up Control.Concurrent's use of an MVar for synchronization
-- from an excellent reference:
-- https://github.com/tibbe/event/blob/master/tests/FileIO.hs

writeOK :: MVar () -> String -> IO()
writeOK done line = do
    iscmd <- case words line of
       ("quit":args) -> do
                        putMVar done ()
                        return False
       (cmd:args) -> return True
       _ -> return False
    if iscmd
       then addHistory line >> putStrLn "OK"
       else return ()

untilIO :: MVar() -> IO()
untilIO done = do
    v <- tryTakeMVar done
    case v of
       Nothing -> do threadDelay 500
                     untilIO done
       Just _  -> do putStrLn ""
                     return ()

main :: IO()
main = do
    hSetBuffering stdin NoBuffering
    done <- newEmptyMVar
    clean <- callbackHandlerInstall ";] " (writeOK done)
    untilIO done

-- end test_rl.hs
``Do you know what this means?  I finally invent something that works!''
-- Doc Brown. to edit.
-- Now we can transform it to use Yampa

module Main where

import FRP.Yampa
import Data.IORef
import System.Console.Readline
import Data.Time.Clock.POSIX
import Data.Functor
import System.IO

--import Control.Concurrent (threadDelay)
import Control.Concurrent.MVar

{- writeOK is now just a handler,
 - no longer in charge of
 - decoding the line and deciding
 - when we're done.
writeOK :: MVar String -> String -> IO()
writeOK out line = do
    putMVar out line -- <- its only critical function.

-- Differentiates the posix clock to make Yampa happy.
updTimer :: IORef POSIXTime -> IO(DTime)
updTimer timeRef = do
    t  <- readIORef timeRef
    t' <- getPOSIXTime
    writeIORef timeRef t'
    return $ realToFrac (t - t')

-- Sets up the IORef to be used by updTimer
setupTimer :: IO(IO(DTime))
setupTimer = do
    timer <- newIORef (0 :: POSIXTime)
    let updTime = updTimer timer
    return updTime

getCmd :: Maybe String -> String
getCmd Nothing = ""
getCmd (Just s) = s

mkSense :: (MVar String, IO(DTime)) -> Bool -> IO (DTime, Maybe String)
mkSense (newInput, updTime) _ = do
    cmd <- getCmd <$> tryTakeMVar newInput
    dt <- updTime
    return (dt, Just cmd)

actuate :: Bool -> (String,(Bool,Bool)) -> IO Bool
actuate _ (line,(hist,done)) = do
    if hist
      then do addHistory line
              putStrLn "OK"
              hFlush stdout
      return ()
    return done

-- save history?, end program?
parseCmd :: String -> (Bool,Bool)
parseCmd line =
    case words line of
       ("quit":args) -> (False,True)
       (cmd:args) -> (True,False)
       _ -> (False,False)

sf :: SF String (String,(Bool,Bool)) -- The signal function to be run
sf = identity &&& arr parseCmd

reactimate :: IO a                          -- init
           -> (Bool -> IO (DTime, Maybe a)) -- input/sense
           -> (Bool -> b -> IO Bool)        -- output/actuate
           -> SF a b                        -- process/signal function
           -> IO ()

main :: IO()
main = do
    hSetBuffering stdin NoBuffering
    -- setup events
    updTime  <- setupTimer
    newInput <- newEmptyMVar
    clean <- callbackHandlerInstall ";] " (writeOK newInput)
    let sense = mkSense (newInput, updTime)

    reactimate (return "") sense actuate sf

  Aside from some cranky issues with having to repeatedly call callbackReadChar, the source shows that readline's input callback works.  Now, we just need to turn that callback into an IORef (or an MVar) that sense can read when it's called.  I also had to add a timer to complete the type of actuate that reactimate needs.  I copied the POSIXTime used in the Hello world example of
and encapsulated the get, subtract, set operation into an IO(DTime) action.

Some more cleaning up lead to the end result at https://github.com/frobnitzem/yrepl.

The interaction is a little less nice because the callback formerly known as writeOK, that sets the newInput MVar, doesn't write "OK", but instead "OK" is written during the actuate step, after sense has returned control to readline (which writes the prompt).  The history also has a strange habit of never appearing which crept in when yampa was introduced.  The upshot is that everything is now asynchronous and controlled by Yampa - woohoo!


Leave a Reply