Interactive results for interactive-diagrams

interactive.hs

{-# LANGUAGE TypeFamilies,
             MultiParamTypeClasses,
             FlexibleInstances,
             UndecidableInstances,
             FunctionalDependencies #-}

import Control.Concurrent
import Control.Monad
import Control.Monad.Fix

import Data.IORef

import System.Random

class Input env a where
  input :: env -> IO () -> IO (IO a)

class Output env a where
  output :: env -> IO (a -> IO ())

type family Result x where
  Result (a -> b) = Result b
  Result a        = a

class Interactive env a b | a -> b where
  interactive :: env -> IO a -> IO () -> IO (IO b)

instance (Input env a, Interactive env b c) => Interactive env (a -> b) c where
  interactive env f upd = do
    a <- input env upd
    interactive env (f `ap` a) upd

instance Interactive env a a where
  interactive env x upd = return x

i :: (b ~ Result a, Output env b, Interactive env a b) => env -> a -> IO ()
i env f = join . mfix $ \redraw -> do
    o   <- output env
    val <- interactive env (return f) redraw
    return (val >>= o)

{-
  Simple example with dummy environment, real use case would use DOM elements
  or perhaps IO actions
 -}

data Web = Web { inputElem  :: String
               , outputElem :: String
               }

defaultWeb :: Web 
defaultWeb = Web "#input" "#output"

-- since we don't have real input in the example, our Int input changes randomly
instance Input Web Int where
  input w upd = do
    putStrLn ("adding int input to: " ++ inputElem w)
    r <- newIORef 0
    forkIO . forever $ do
      threadDelay =<< randomRIO (1000000,5000000)
      step <- randomRIO (1,10)
      putStrLn "input updated"
      modifyIORef r (+step)
      upd
    return (readIORef r)

instance Output Web Int where
  output w = do
    putStrLn ("adding int output to: " ++ outputElem w)
    return (\x -> putStrLn ("updating output at " ++ outputElem w ++ ": " ++ show x))

plus :: Int -> Int -> Int
plus = (*)

-- functions with Input parameters and an Output result are Interactive
x :: IO ()
x = i defaultWeb plus

-- plain values are also Interactive, as long as they're an instance of Output
y :: IO ()
y = i defaultWeb (123::Int)