diff --git a/peakachu.cabal b/peakachu.cabal
--- a/peakachu.cabal
+++ b/peakachu.cabal
@@ -1,9 +1,10 @@
 Name:                peakachu
-Version:             0.1
+Version:             0.2
 Category:            FRP
-Synopsis:            An FRP library with a GLUT backend
+Synopsis:            Experiemental library for composable interactive programs
 Description:
-  An experiemental simple FRP library.
+  Experiemental library for composable interactive programs.
+
   GLUT backend included.
 License:             BSD3
 License-file:        LICENSE
@@ -16,9 +17,21 @@
 Library
   hs-Source-Dirs:      src
   Extensions:
-  Build-Depends:       base >= 3 && < 5, GLUT
+  Build-Depends:       base >= 3 && < 5, template-haskell,
+                       TypeCompose, derive,
+                       GLUT, time
   Exposed-modules:     FRP.Peakachu
+                       FRP.Peakachu.Program
+                       FRP.Peakachu.Backend
+                       FRP.Peakachu.Backend.File
                        FRP.Peakachu.Backend.GLUT
-                       FRP.Peakachu.Internal
-  ghc-options:         -Wall
+                       FRP.Peakachu.Backend.GLUT.Getters
+                       FRP.Peakachu.Backend.StdIO
+                       FRP.Peakachu.Backend.Time
+                       Control.Concurrent.MVar.YC
+                       Control.FilterCategory
+                       Data.ADT.Getters
+                       Data.Bijection.YC
+                       Data.Newtype
+  ghc-options:         -O2 -Wall
 
diff --git a/src/Control/Concurrent/MVar/YC.hs b/src/Control/Concurrent/MVar/YC.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Concurrent/MVar/YC.hs
@@ -0,0 +1,13 @@
+module Control.Concurrent.MVar.YC (
+  modifyMVarPure, writeMVar
+  ) where
+
+import Control.Applicative ()
+import Control.Concurrent.MVar (MVar, modifyMVar_)
+
+modifyMVarPure :: MVar a -> (a -> a) -> IO ()
+modifyMVarPure mvar = modifyMVar_ mvar . fmap return
+
+writeMVar :: MVar a -> a -> IO ()
+writeMVar mvar = modifyMVarPure mvar . const
+
diff --git a/src/Control/FilterCategory.hs b/src/Control/FilterCategory.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/FilterCategory.hs
@@ -0,0 +1,33 @@
+-- | A FilterCategory is a Category that supports mapMaybeC.
+--
+-- In Peakachu, both Program and Backend are instances of FilterCategory.
+
+module Control.FilterCategory
+  ( FilterCategory(..)
+  , genericFlattenC, mapMaybeC, filterC
+  ) where
+
+import Control.Category (Category(..))
+import Control.Monad (guard)
+import Data.Foldable (Foldable(..), toList)
+
+import Prelude hiding ((.), id)
+
+class Category cat => FilterCategory cat where
+  flattenC :: cat [a] a
+  arrC :: (a -> b) -> cat a b
+
+genericFlattenC :: (FilterCategory cat, Foldable f) => cat (f a) a
+genericFlattenC = flattenC . arrC toList
+
+mapMaybeC :: FilterCategory cat => (a -> Maybe b) -> cat a b
+mapMaybeC f = genericFlattenC . arrC f
+
+filterC :: FilterCategory cat => (a -> Bool) -> cat a a
+filterC cond =
+  mapMaybeC f
+  where
+    f x = do
+      guard $ cond x
+      return x
+
diff --git a/src/Data/ADT/Getters.hs b/src/Data/ADT/Getters.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ADT/Getters.hs
@@ -0,0 +1,60 @@
+-- | ADT getters generation with Template Haskell
+--
+-- Example:
+--
+-- > {-# LANGUAGE TemplateHaskell #-}
+-- > data Blah a = NoBlah | YesBlah a | ManyBlah a Int
+-- > $(mkADTGetters ''Blah)
+--
+-- Generates
+--
+-- > gNoBlah :: Blah a -> Maybe ()
+-- > gYesBlah :: Blah a -> Maybe a
+-- > gManyBlah :: Blah a -> Maybe (a, Int)
+--
+-- Where
+--
+-- > gYesBlah (YesBlah a) = Just a
+-- > gYesBlah _ = Nothing
+--
+-- etc.
+
+module Data.ADT.Getters
+  ( mkADTGetters
+  ) where
+
+import Language.Haskell.TH.Syntax
+
+mkADTGetters :: Name -> Q [Dec]
+mkADTGetters typeName = do
+  TyConI (DataD _ _ typeVars constructors _) <- reify typeName
+  return $ constructors >>= mkADTGetterFunc typeName typeVars
+
+mkADTGetterFunc :: Name -> [Name] -> Con -> [Dec]
+mkADTGetterFunc typeName typeVars constructor =
+  [ SigD resName
+    . ForallT typeVars []
+    . AppT (AppT ArrowT (foldl AppT (ConT typeName) (map VarT typeVars)))
+    . AppT (ConT (mkName "Maybe"))
+    $ case containedTypes of
+    [] -> TupleT 0
+    [x] -> x
+    xs -> foldl AppT (TupleT (length xs)) xs
+  , FunD resName
+    [ Clause [ConP name (map VarP varNames)] clauseJust []
+    , Clause [WildP] clauseNothing []
+    ]
+  ]
+  where
+    NormalC name params = constructor
+    containedTypes = map snd params
+    resName = mkName $ 'g' : nameBase name
+    varNames = map (mkName . ('x' :) . show) [0 .. length params - 1]
+    clauseJust =
+      NormalB . AppE (ConE (mkName "Just"))
+      $ case varNames of
+      [] -> TupE []
+      [x] -> VarE x
+      xs -> TupE (map VarE xs)
+    clauseNothing = NormalB . ConE . mkName $ "Nothing"
+
diff --git a/src/Data/Bijection/YC.hs b/src/Data/Bijection/YC.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Bijection/YC.hs
@@ -0,0 +1,34 @@
+-- | In/with functions for bijective functions
+--
+-- Example:
+--
+-- > import Data.Bijection (Bijection(..), bimap)
+-- > import Data.Bijection.YC (withBi2)
+-- > import Data.Monoid (Monoid(..), Sum(..))
+-- >
+-- > biSum :: Num a => Bijection (->) a (Sum a)
+-- > biSum = Bi Sum getSum
+-- >
+-- > > withBi2 (bimap biSum) mappend (Just 5) (Just 7)
+-- > Just 12
+-- >
+-- > > withBi2 (bimap biSum) mappend Nothing (Just 7)
+-- > Just 7
+
+module Data.Bijection.YC
+  ( withBi, inBi2, withBi2
+  ) where
+
+import Control.Arrow (Arrow)
+import Data.Bijection (Bijection(..), inBi, inverse)
+
+withBi :: Arrow x => Bijection x a b -> x b b -> x a a
+withBi = inBi . inverse
+
+inBi2 :: Bijection (->) a b -> (a -> a -> a) -> b -> b -> b
+inBi2 bi func left right =
+  biTo bi $ func (biFrom bi left) (biFrom bi right)
+
+withBi2 :: Bijection (->) a b -> (b -> b -> b) -> a -> a -> a
+withBi2 = inBi2 . inverse
+
diff --git a/src/Data/Newtype.hs b/src/Data/Newtype.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Newtype.hs
@@ -0,0 +1,95 @@
+-- | In/with newtype functions generation with Template Haskell.
+--
+-- Example:
+--
+-- > {-# LANGUAGE TemplateHaskell #-}
+-- > import Control.Applicative (Applicative(..), ZipList(..))
+-- > import Data.Newtype (mkWithNewTypeFuncs)
+-- >
+-- > $(mkWithNewtypeFuncs [2] ''ZipList)
+-- >
+-- > > withZipList2 (<*>) [(+3), (*3)] [6, 7]
+-- > [9, 21]
+
+module Data.Newtype
+  ( mkInNewtypeFuncs, mkWithNewtypeFuncs
+  ) where
+
+import Control.Applicative ((<$>), (<*>))
+import Language.Haskell.TH.Syntax
+
+nameAddSuf :: String -> Name -> Name
+nameAddSuf suf name = mkName (nameBase name ++ suf)
+
+typeAddSuf :: String -> Type -> Type
+typeAddSuf suf (ForallT names cxt typ) =
+  ForallT
+    (nameAddSuf suf <$> names)
+    (typeAddSuf suf <$> cxt)
+    (typeAddSuf suf typ)
+typeAddSuf suf (VarT name) = VarT (nameAddSuf suf name)
+typeAddSuf suf (AppT left right) =
+  AppT (typeAddSuf suf left) (typeAddSuf suf right)
+typeAddSuf _ x = x
+
+data NewtypeFunc = In | With
+
+mkInNewtypeFuncs :: [Int] -> Name -> Q [Dec]
+mkInNewtypeFuncs idx typeName = do
+  info <- reify typeName
+  return $ idx >>= mkNewTypeFunc info In
+
+mkWithNewtypeFuncs :: [Int] -> Name -> Q [Dec]
+mkWithNewtypeFuncs idx typeName = do
+  info <- reify typeName
+  return $ idx >>= mkNewTypeFunc info With
+
+mkNewTypeFunc :: Info -> NewtypeFunc -> Int -> [Dec]
+mkNewTypeFunc info whatFunc funcIdx =
+  [ SigD resName
+    . ForallT
+      ( nameAddSuf <$> typeSuffixes <*> typeVars )
+      ( typeAddSuf <$> typeSuffixes <*> context )
+    . AppT (AppT ArrowT (mkFuncType inputType))
+    $ mkFuncType outputType
+  , FunD resName [clause]
+  ]
+  where
+    TyConI newtypeDef = info
+    NewtypeD context typeName typeVars constructor _ = newtypeDef
+    (consName, inType) =
+      case constructor of
+        NormalC c [(_, i)] -> (c, i)
+        RecC c [(_, _, i)] -> (c, i)
+        _ -> undefined
+    fName = mkName "f"
+    xNames = mkName . ('x' :) . show <$> [0 .. funcIdx - 1]
+    resName = mkName $ prefix ++ nameBase typeName ++ show funcIdx
+    typeSuffixes = show <$> [0 .. funcIdx]
+    fullType = foldl AppT (ConT typeName) (map VarT typeVars)
+    mkFuncType base =
+      foldr AppT (typeAddSuf (last typeSuffixes) base)
+      $ AppT ArrowT . (`typeAddSuf` base) <$> init typeSuffixes
+    withResName = mkName "res"
+    (prefix, inputType, outputType, clause) =
+      case whatFunc of
+        In ->
+          ( "in", inType, fullType
+          , Clause (VarP fName : (ConP consName . return . VarP <$> xNames))
+            ( NormalB
+            . AppE (ConE consName)
+            . foldl AppE (VarE fName)
+            $ VarE <$> xNames
+            ) []
+          )
+        With ->
+          ( "with", fullType, inType
+          , Clause (VarP <$> fName : xNames)
+            (NormalB (VarE withResName))
+            [ ValD (ConP consName [VarP withResName])
+              ( NormalB
+              . foldl AppE (VarE fName)
+              $ AppE (ConE consName) . VarE <$> xNames
+              ) []
+            ]
+          )
diff --git a/src/FRP/Peakachu.hs b/src/FRP/Peakachu.hs
--- a/src/FRP/Peakachu.hs
+++ b/src/FRP/Peakachu.hs
@@ -1,38 +1,60 @@
-{-# OPTIONS -O2 -Wall #-}
-
-module FRP.Peakachu (
-  Event, escanl, efilter,
-  edrop, ereturn, ezip, ezip'
+module FRP.Peakachu
+  ( runProgram
   ) where
 
-import FRP.Peakachu.Internal (Event, escanl, efilter)
-import Data.Monoid (mappend, mempty)
-
-ezip :: Event a -> Event b -> Event (Maybe a, Maybe b)
-ezip as bs =
-  escanl step (Nothing, Nothing) $ fmap Left as `mappend` fmap Right bs
-  where
-    step (_, r) (Left l) = (Just l, r)
-    step (l, _) (Right r) = (l, Just r)
+import FRP.Peakachu.Backend (Backend(..), Sink(..))
+import FRP.Peakachu.Program (Program(..))
+import Control.Concurrent.MVar.YC (writeMVar)
 
-ezip' :: Event a -> Event b -> Event (a, b)
-ezip' as bs =
-  fmap m . efilter f $ ezip as bs
-  where
-    f (Just _, Just _) = True
-    f _ = False
-    m (Just l, Just r) = (l, r)
-    m _ = undefined
+import Control.Concurrent (forkIO, threadDelay)
+import Control.Concurrent.MVar (newMVar, putMVar, readMVar, takeMVar)
+import Control.Monad (when)
+import Data.Function (fix)
+import Data.Maybe (isNothing)
 
-ereturn :: a -> Event a
-ereturn x = escanl (const id) x mempty
+doWhile :: Monad m => m Bool -> m ()
+doWhile x = fix $ (x >>=) . flip when
 
-edrop :: Integral i => i -> Event a -> Event a
-edrop count =
-  fmap snd .
-  efilter ((== 0) . fst) .
-  escanl step (count+1, undefined)
-  where
-    step (0, _) x = (0, x)
-    step (i, _) x = (i-1, x)
+runProgram :: Backend o i -> Program i o -> IO ()
+runProgram backend program = do
+  progVar <- newMVar program
+  resumeVar <- newMVar True
+  sinkVar <- newMVar Nothing
+  let
+    consumeOutput =
+      doWhile $ do
+        Just sink <- readMVar sinkVar
+        prog@(Program vals more) <- takeMVar progVar
+        case vals of
+          [] -> do
+            putMVar progVar prog
+            when (isNothing (progMore prog)) $ do
+              sinkQuitLoop sink
+              writeMVar resumeVar False
+            return False
+          (x : xs) -> do
+            putMVar progVar $ Program xs more
+            sinkConsume sink x
+            return True
+    handleInput val = do
+      prog@(Program vals maybeMore) <- takeMVar progVar
+      case maybeMore of
+        Nothing ->
+          putMVar progVar prog
+        Just more -> do
+          let Program mVals mMore = more val
+          putMVar progVar $ Program (vals ++ mVals) mMore
+          consumeOutput
+  sink <- runBackend backend handleInput
+  writeMVar sinkVar (Just sink)
+  sinkInit sink
+  forkIO $ do
+    threadDelay 300000
+    consumeOutput
+  case sinkMainLoop sink of
+    Nothing ->
+      doWhile $ do
+        threadDelay 200000 -- 0.2 sec
+        readMVar resumeVar
+    Just mainloop -> mainloop
 
diff --git a/src/FRP/Peakachu/Backend.hs b/src/FRP/Peakachu/Backend.hs
new file mode 100644
--- /dev/null
+++ b/src/FRP/Peakachu/Backend.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module FRP.Peakachu.Backend
+  ( Backend(..), Sink(..)
+  ) where
+
+import Control.FilterCategory (FilterCategory(..))
+import Data.Newtype (mkInNewtypeFuncs)
+
+import Control.Category (Category(..))
+import Control.Concurrent (forkIO)
+import Control.Monad (liftM2)
+import Data.Generics.Aliases (orElse)
+import Data.Function (on)
+import Data.Monoid (Monoid(..))
+
+import Prelude hiding ((.), id)
+
+data Sink a = Sink
+  { sinkConsume :: a -> IO ()
+  , sinkInit :: IO ()
+  , sinkMainLoop :: Maybe (IO ())
+  , sinkQuitLoop :: IO ()
+  }
+
+combineMainLoops :: Maybe (IO ()) -> Maybe (IO ()) -> Maybe (IO ())
+combineMainLoops (Just x) (Just y) = Just $ forkIO x >> y
+combineMainLoops x y = orElse x y
+
+instance Monoid (Sink a) where
+  mempty = Sink (const (return ())) (return ()) Nothing (return ())
+  mappend a b =
+    Sink
+    { sinkConsume = on (liftM2 (>>)) sinkConsume a b
+    , sinkInit = on (>>) sinkInit a b
+    , sinkMainLoop = on combineMainLoops sinkMainLoop a b
+    , sinkQuitLoop = on (>>) sinkQuitLoop a b
+    }
+
+newtype Backend progToBack backToProg =
+  Backend
+  { runBackend :: (backToProg -> IO ()) -> IO (Sink progToBack)
+  } -- if Monoid m => Monoid (IO m)
+  -- then could use GeneralizedNewtypeDeriving for Monoid
+
+$(mkInNewtypeFuncs [1,2] ''Backend)
+
+instance Monoid (Backend p2b b2p) where
+  mempty = Backend . return . return $ mempty
+  mappend = inBackend2 . liftM2 . liftM2 $ mappend
+
+instance Functor (Backend p2b) where
+  fmap =
+    inBackend1 . arg . arg
+    where
+      arg = flip (.)
+
+instance Category Backend where
+  id =
+    Backend f
+    where
+      f handler =
+        return mempty { sinkConsume = handler }
+  Backend left . Backend right =
+    Backend f
+    where
+      f handler = do
+        sinkLeft <- left handler
+        sinkRight <- right . sinkConsume $ sinkLeft
+        return sinkRight
+          { sinkInit =
+              sinkInit sinkLeft >> sinkInit sinkRight
+          , sinkMainLoop =
+              combineMainLoops
+              (sinkMainLoop sinkLeft) (sinkMainLoop sinkRight)
+          , sinkQuitLoop =
+              sinkQuitLoop sinkLeft >> sinkQuitLoop sinkRight
+          }
+
+instance FilterCategory Backend where
+  flattenC = Backend (runBackend id . mapM_)
+  arrC = (`fmap` id)
+
diff --git a/src/FRP/Peakachu/Backend/File.hs b/src/FRP/Peakachu/Backend/File.hs
new file mode 100644
--- /dev/null
+++ b/src/FRP/Peakachu/Backend/File.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module FRP.Peakachu.Backend.File
+  ( FileToProgram(..), ProgramToFile(..), fileB
+  , gFileData, gFileError
+  ) where
+
+import Data.ADT.Getters (mkADTGetters)
+import FRP.Peakachu.Backend (Backend(..), Sink(..))
+
+import Control.Monad (join)
+import Data.Function (fix)
+import Data.Monoid (Monoid(..))
+import System.IO (IOMode(ReadMode), openFile, hClose, hGetChar)
+import System.IO.Error (try, isEOFError)
+
+data FileToProgram a
+  = FileData String a
+  | FileError a
+$(mkADTGetters ''FileToProgram)
+
+data ProgramToFile a
+  = ReadFile FilePath a
+  | WriteFile FilePath String a
+
+maybeIO :: (IOError -> Bool) -> IO a -> IO (Maybe a)
+maybeIO isExpected =
+  join . fmap f . try
+  where
+    f (Right x) = return $ Just x
+    f (Left err)
+      | isExpected err = return Nothing
+      | otherwise = ioError err
+
+-- Lazy IO forbidden because imho it is horrible
+strictReadFile :: FilePath -> IO String
+strictReadFile filename = do
+  file <- openFile filename ReadMode
+  contents <- fix $ \rest -> do
+    mc <- maybeIO isEOFError $ hGetChar file
+    case mc of
+      Nothing -> return ""
+      Just c -> fmap (c :) rest
+  hClose file
+  return contents
+
+fileB :: Backend (ProgramToFile a) (FileToProgram a)
+fileB =
+  Backend f
+  where
+    f handler =
+      return mempty { sinkConsume = consume }
+      where
+        consume (ReadFile filename tag) =
+          strictReadFile filename >>=
+          handler . (`FileData` tag)
+        consume (WriteFile filename contents _) =
+          writeFile filename contents
+
diff --git a/src/FRP/Peakachu/Backend/GLUT.hs b/src/FRP/Peakachu/Backend/GLUT.hs
--- a/src/FRP/Peakachu/Backend/GLUT.hs
+++ b/src/FRP/Peakachu/Backend/GLUT.hs
@@ -1,23 +1,29 @@
-{-# OPTIONS -O2 -Wall #-}
+{-# LANGUAGE TemplateHaskell #-}
 
-module FRP.Peakachu.Backend.GLUT (
-  Image(..), UI(..), run
+module FRP.Peakachu.Backend.GLUT
+  ( GlutToProgram(..), Image(..), ProgramToGlut(..), glut
+  , gIdleEvent, gTimerEvent, gMouseMotionEvent
+  , gKeyboardMouseEvent
   ) where
 
+import Control.Concurrent.MVar.YC (modifyMVarPure)
+import Data.ADT.Getters (mkADTGetters)
+import FRP.Peakachu.Backend (Backend(..), Sink(..))
+
+import Control.Concurrent.MVar (newMVar, putMVar, takeMVar)
 import Data.Monoid (Monoid(..))
-import FRP.Peakachu (ereturn)
-import FRP.Peakachu.Internal (Event(..), makeCallbackEvent)
-import Graphics.UI.GLUT (
-  ($=), ($~), SettableStateVar, get,
-  ClearBuffer(..), Key(..), KeyState(..),
-  Modifiers, Position(..), GLfloat, Size(..),
-  DisplayMode(..), initialDisplayMode, swapBuffers,
-  createWindow, getArgsAndInitialize,
-  displayCallback, keyboardMouseCallback,
-  motionCallback, passiveMotionCallback,
-  windowSize,
-  clear, flush, mainLoop)
-import Prelude hiding (repeat)
+import Graphics.UI.GLUT
+  ( GLfloat, ($=), ($~), get
+  , ClearBuffer(..), Key(..), KeyState(..)
+  , Modifiers, Position(..), Size(..), Timeout
+  , DisplayMode(..), initialDisplayMode, swapBuffers
+  , createWindow, getArgsAndInitialize
+  , displayCallback, idleCallback
+  , keyboardMouseCallback
+  , motionCallback, passiveMotionCallback
+  , windowSize, addTimerCallback
+  , clear, flush, mainLoop, leaveMainLoop
+  )
 
 data Image = Image { runImage :: IO ()}
 
@@ -25,54 +31,67 @@
   mempty = Image $ return ()
   mappend (Image a) (Image b) = Image $ a >> b
 
-data UI = UI {
-  mouseMotionEvent :: Event (GLfloat, GLfloat),
-  glutKeyboardMouseEvent :: Event (Key, KeyState, Modifiers, Position)
-  }
-
-makeCallbackEvent' ::
-  SettableStateVar (Maybe b) ->
-  ((a -> IO ()) -> b) ->
-  IO (Event a)
-makeCallbackEvent' callbackVar trans = do
-  (event, callback) <- makeCallbackEvent
-  callbackVar $= Just (trans callback)
-  return event
-
-createUI :: IO UI
-createUI = do
-  Size sx sy <- get windowSize
-  glutMotionEvent <- makeCallbackEvent' motionCallback id
-  glutPassiveMotionEvent <- makeCallbackEvent' passiveMotionCallback id
-  glutKeyboardMouseE <-
-    makeCallbackEvent' keyboardMouseCallback $
-    \cb a b c d -> cb (a,b,c,d)
-  let
-    pixel2gl (Position px py) = (p2g sx px, - p2g sy py)
-    p2g sa pa = 2 * fromIntegral pa / fromIntegral sa - 1
-  return UI {
-    glutKeyboardMouseEvent = glutKeyboardMouseE,
-    mouseMotionEvent =
-      mappend (ereturn (0, 0)) . -- is there a way to get the initial mouse position?
-      fmap pixel2gl $
-      mappend glutMotionEvent glutPassiveMotionEvent
-  }
+data GlutToProgram a
+  = IdleEvent
+  | TimerEvent a
+  | MouseMotionEvent GLfloat GLfloat
+  | KeyboardMouseEvent Key KeyState Modifiers Position
+$(mkADTGetters ''GlutToProgram)
 
-draw :: Image -> IO ()
-draw image = do
-  clear [ ColorBuffer ]
-  runImage image
-  swapBuffers
-  flush
+data ProgramToGlut a
+  = DrawImage Image
+  | SetTimer Timeout a
 
-run :: (UI -> Event Image) -> IO ()
-run programDesc = do
-  _ <- getArgsAndInitialize
-  initialDisplayMode $~ (DoubleBuffered:)
-  createWindow "test"
-  program <- fmap programDesc createUI
-  mapM_ draw (initialValues program)
-  addHandler program draw
-  displayCallback $= return ()
-  mainLoop
+glut :: Backend (ProgramToGlut a) (GlutToProgram a)
+glut =
+  Backend b
+  where
+    b handler = do
+      _ <- getArgsAndInitialize
+      initialDisplayMode $~ (DoubleBuffered:)
+      createWindow "test"
+      displayCallback $= return ()
+      -- all the OpenGL drawing must be performed from the same thread
+      -- that runs the GLUT event-loop.
+      -- so instead of consuming when given input, we add it to the todo-list.
+      -- the next time any GLUT event comes (should be immediate),
+      -- we consume all the todo-list.
+      -- without this mechanism the graphics flickers.
+      todoVar <- newMVar []
+      let
+        consume (DrawImage image) = do
+          clear [ ColorBuffer ]
+          runImage image
+          swapBuffers
+          flush
+        consume (SetTimer timeout tag) =
+          -- there seems to be a bug with addTimerCallback.
+          -- sometimes it calls you back straight away..
+          -- but doing a work around with an io-thread seems
+          -- to be very slow
+          addTimerCallback timeout . handler . TimerEvent $ tag
+        preHandler event = do
+          todo <- takeMVar todoVar
+          putMVar todoVar []
+          mapM_ consume . reverse $ todo
+          handler event
+        setCallbacks = do
+          idleCallback $= Just (preHandler IdleEvent)
+          keyboardMouseCallback $=
+            Just (
+            (fmap . fmap . fmap . fmap)
+            preHandler KeyboardMouseEvent)
+          motionCallback $= Just motion
+          passiveMotionCallback $= Just motion
+        motion (Position px py) = do
+          Size sx sy <- get windowSize
+          preHandler $ MouseMotionEvent (p2g sx px) (- p2g sy py)
+        p2g sa pa = 2 * fromIntegral pa / fromIntegral sa - 1
+      setCallbacks
+      return Sink
+        { sinkConsume = modifyMVarPure todoVar . (:)
+        , sinkInit = handler $ MouseMotionEvent 0 0
+        , sinkMainLoop = Just mainLoop
+        , sinkQuitLoop = leaveMainLoop
+        }
 
diff --git a/src/FRP/Peakachu/Backend/GLUT/Getters.hs b/src/FRP/Peakachu/Backend/GLUT/Getters.hs
new file mode 100644
--- /dev/null
+++ b/src/FRP/Peakachu/Backend/GLUT/Getters.hs
@@ -0,0 +1,17 @@
+-- | ADT getter functions for GLUT data types.
+--
+-- Useful for filtering GLUT events in the Maybe monad.
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module FRP.Peakachu.Backend.GLUT.Getters
+  ( gChar, gMouseButton, gSpecialKey, gDown, gUp
+  ) where
+
+import Data.ADT.Getters (mkADTGetters)
+
+import Graphics.UI.GLUT (Key(..), KeyState(..))
+
+$(mkADTGetters ''Key)
+$(mkADTGetters ''KeyState)
+
diff --git a/src/FRP/Peakachu/Backend/StdIO.hs b/src/FRP/Peakachu/Backend/StdIO.hs
new file mode 100644
--- /dev/null
+++ b/src/FRP/Peakachu/Backend/StdIO.hs
@@ -0,0 +1,19 @@
+-- | A Peakachu backend to write output to the console
+
+module FRP.Peakachu.Backend.StdIO (stdoutB) where
+
+import FRP.Peakachu.Backend (Backend(..), Sink(..))
+
+import Data.Monoid (mempty)
+import System.IO (hFlush, stdout)
+
+stdoutB :: Backend String ()
+stdoutB =
+  Backend . const . return $ mempty
+  { sinkConsume = consume
+  }
+  where
+    consume x = do
+      putStr x
+      hFlush stdout
+
diff --git a/src/FRP/Peakachu/Backend/Time.hs b/src/FRP/Peakachu/Backend/Time.hs
new file mode 100644
--- /dev/null
+++ b/src/FRP/Peakachu/Backend/Time.hs
@@ -0,0 +1,21 @@
+-- | A Peakachu backend to get the time
+
+module FRP.Peakachu.Backend.Time
+  ( getTimeB
+  ) where
+
+import Data.Monoid (Monoid(..))
+import FRP.Peakachu.Backend (Backend(..), Sink(..))
+
+import Data.Time.Clock (UTCTime, getCurrentTime)
+
+getTimeB :: Backend a (UTCTime, a)
+getTimeB =
+  Backend f
+  where
+    f handler =
+      return mempty { sinkConsume = consume }
+      where
+        consume tag = do
+          now <- getCurrentTime
+          handler (now, tag)
diff --git a/src/FRP/Peakachu/Internal.hs b/src/FRP/Peakachu/Internal.hs
deleted file mode 100644
--- a/src/FRP/Peakachu/Internal.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# OPTIONS -O2 -Wall #-}
-
-module FRP.Peakachu.Internal (
-  Event(..), escanl, efilter,
-  makeCallbackEvent
-  ) where
-
-import Control.Concurrent.MVar (
-  newMVar, putMVar, readMVar, takeMVar)
-import Control.Monad (when)
-import Data.Monoid (Monoid(..))
-
-data Event a = Event {
-  addHandler :: (a -> IO ()) -> IO (),
-  initialValues :: [a]
-}
-
-instance Functor Event where
-  fmap func event =
-    Event {
-      addHandler = addHandler event . (. func),
-      initialValues = map func (initialValues event)
-    }
-
-instance Monoid (Event a) where
-  mempty =
-    Event {
-      addHandler = const (return ()),
-      initialValues = []
-    }
-  mappend x y =
-    Event {
-      addHandler = \handler -> do
-        addHandler x handler
-        addHandler y handler,
-      initialValues = initialValues x ++ initialValues y
-    }
-
-escanl :: (a -> b -> a) -> a -> Event b -> Event a
-escanl step startVal event =
-  Event {
-    addHandler = \handler -> do
-      accVar <- newMVar (last initValues)
-      let
-        srcHandler val = do
-          prevAcc <- takeMVar accVar
-          let newAcc = step prevAcc val
-          putMVar accVar newAcc
-          handler newAcc
-      addHandler event srcHandler,
-    initialValues = initValues
-  }
-  where
-    initValues = scanl step startVal (initialValues event)
-
-efilter :: (a -> Bool) -> Event a -> Event a
-efilter cond event =
-  Event {
-    addHandler = \handler -> do
-      let
-        srcHandler val =
-          when (cond val) (handler val)
-      addHandler event srcHandler,
-    initialValues = filter cond (initialValues event)
-  }
-
-makeCallbackEvent :: IO (Event a, a -> IO ())
-makeCallbackEvent = do
-  dstHandlersVar <- newMVar []
-  let
-    srcHandler val =
-      mapM_ ($ val) =<< readMVar dstHandlersVar
-    event =
-      Event {
-        addHandler = \handler ->
-          takeMVar dstHandlersVar >>=
-          putMVar dstHandlersVar . (handler :),
-        initialValues = []
-      }
-  return (event, srcHandler)
-
diff --git a/src/FRP/Peakachu/Program.hs b/src/FRP/Peakachu/Program.hs
new file mode 100644
--- /dev/null
+++ b/src/FRP/Peakachu/Program.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell #-}
+
+module FRP.Peakachu.Program
+  ( Program(..), MergeProgram(..), AppendProgram(..)
+  , ProgCat(..)
+  , singleValueP, lstP, lstPs, delayP
+  ) where
+
+import Control.FilterCategory (FilterCategory(..), genericFlattenC)
+import Data.ADT.Getters (mkADTGetters)
+import Data.Bijection.YC (withBi2)
+import Data.Newtype (mkWithNewtypeFuncs)
+
+import Control.Applicative (Applicative(..), (<$>), liftA2)
+import Control.Category (Category(..))
+import Control.Monad (MonadPlus(..), ap)
+import Data.Bijection (Bijection(..), bimap)
+import Data.Generics.Aliases (orElse)
+import Data.List (genericDrop, genericTake)
+import Data.Maybe (mapMaybe, catMaybes)
+import Data.Monoid (Monoid(..))
+
+import Prelude hiding ((.), id)
+
+data Program a b = Program
+  { progVals :: [b]
+  , progMore :: Maybe (a -> Program a b)
+  }
+
+class FilterCategory prog => ProgCat prog where
+  scanlP :: (b -> a -> b) -> b -> prog a b
+  emptyP :: prog a b
+  takeWhileP :: (a -> Bool) -> prog a a
+  loopbackP :: prog a (Either a b) -> prog a b
+
+singleValueP :: ProgCat prog => prog a ()
+singleValueP = scanlP const () . emptyP
+
+delayP :: (Integral i, ProgCat prog) => i -> prog a a
+delayP n =
+  flattenC . arrC (genericDrop n) . scanlP step []
+  where
+    step xs = (: genericTake n xs)
+
+instance Category Program where
+  id =
+    Program [] (Just f)
+    where
+      f x = Program [x] (Just f)
+  left . right =
+    Program (catMaybes stuff >>= progVals) more
+    where
+      Program rightStart rightMore = right
+      stuff = scanl step (Just left) rightStart
+      step l valRight = do
+        Program _ moreLeft <- l
+        moreFunc <- moreLeft
+        return $ moreFunc valRight
+      more = do
+        moreFunc <- rightMore
+        lastStuff <- last stuff
+        return $ (.) (Program [] (progMore lastStuff)) . moreFunc
+
+instance Functor (Program a) where
+  fmap f p =
+    Program
+    { progVals = fmap f . progVals $ p
+    , progMore = (fmap . fmap . fmap) f . progMore $ p
+    }
+
+instance FilterCategory Program where
+  flattenC =
+    f []
+    where
+      f = (`Program` Just f)
+  arrC = (<$> id)
+
+$(mkADTGetters ''Either)
+
+instance ProgCat Program where
+  emptyP = Program [] Nothing
+  scanlP step start =
+    Program [start] $ Just (scanlP step . step start)
+  takeWhileP cond =
+    Program [] (Just f)
+    where
+      f x
+        | cond x = Program [x] (Just f)
+        | otherwise = Program [] Nothing
+  loopbackP program =
+    Program
+    { progVals = stuff >>= mapMaybe gRight . progVals
+    , progMore = (fmap . fmap) loopbackP . progMore . last $ stuff
+    }
+    where
+      stuff =
+        scanl step program
+        . mapMaybe gLeft . progVals $ program
+      step prev val =
+        maybe emptyP ($ val) (progMore prev)
+
+newtype MergeProgram a b = MergeProg
+  { runMergeProg :: Program a b
+  } deriving (Category, FilterCategory, Functor, ProgCat)
+
+$(mkWithNewtypeFuncs [2] ''MergeProgram)
+
+biMergeProg :: Bijection (->) (Program a b) (MergeProgram a b)
+biMergeProg = Bi MergeProg runMergeProg
+
+instance Monoid (MergeProgram a b) where
+  mempty = emptyP
+  mappend (MergeProg left) (MergeProg right) =
+    MergeProg Program
+    { progVals =
+      mappend (progVals left) (progVals right)
+    , progMore =
+      withBi2 ((bimap . bimap) biMergeProg)
+      mappend (progMore left) (progMore right)
+    }
+
+instance Applicative (MergeProgram a) where
+  pure x =
+    MergeProg Program
+    { progVals = pure x
+    , progMore = pure . pure . runMergeProg . pure $ x
+    }
+  MergeProg left <*> MergeProg right =
+    MergeProg Program
+    { progVals = progVals left <*> progVals right
+    , progMore =
+      (liftA2 . liftA2 . withMergeProgram2)
+      (<*>) (progMore left) (progMore right)
+    }
+
+newtype AppendProgram a b = AppendProg
+  { runAppendProg :: Program a b
+  } deriving (Category, FilterCategory, Functor, ProgCat)
+
+$(mkWithNewtypeFuncs [1,2] ''AppendProgram)
+
+instance Monoid (AppendProgram a b) where
+  mempty = emptyP
+  mappend (AppendProg left) (AppendProg right) =
+    AppendProg $
+    case progMore left of
+      Nothing -> Program
+        { progVals = progVals left ++ progVals right
+        , progMore = progMore right
+        }
+      Just more -> Program
+        { progVals = progVals left
+        , progMore = Just $ flip (withAppendProgram2 mappend) right <$> more
+        }
+
+instance Monad (AppendProgram a) where
+  return x = AppendProg $ Program [x] Nothing
+  AppendProg left >>= right =
+    mconcat $ map right (progVals left) ++ [rest]
+    where
+      rest =
+        AppendProg Program
+        { progVals = []
+        , progMore =
+          (fmap . fmap . withAppendProgram1)
+          (>>= right) (progMore left)
+        }
+
+instance MonadPlus (AppendProgram a) where
+  mzero = mempty
+  mplus = mappend
+
+instance Applicative (AppendProgram a) where
+  pure = return
+  (<*>) = ap
+
+lstPs :: ProgCat prog => Maybe b -> (a -> Maybe b) -> prog a b
+lstPs start f =
+  genericFlattenC . scanlP (flip orElse) start . arrC f
+
+lstP :: ProgCat prog => (a -> Maybe b) -> prog a b
+lstP = lstPs Nothing
+