Main.hs

{-# LANGUAGE JavaScriptFFI #-}

{- This code compiles and runs just fine -}

module Main where

import Control.Concurrent.MVar
import qualified Control.Exception as Ex
import GHCJS.Types
import GHCJS.Foreign
import GHCJS.Marshal
import System.IO.Unsafe (unsafePerformIO)


foreign import javascript unsafe "$1($2)"
  js_fooApply :: JSFun (JSRef a -> IO ())
	      -> JSRef a 
	      -> IO (JSRef ())

-- | @fooApply f x@ applies @f@ to @x@ on JavaScript and returns the result.
--
-- As long as the 'FromJSRef' and 'ToJSRef' instances don't do anything funny:
-- @fooApply f x@ == @return (f x)@  
fooApply  
  :: (FromJSRef a, ToJSRef a, FromJSRef b, ToJSRef b) 
  => (a -> b) 
  -> a 
  -> IO b
fooApply f a0 = do
    a0Ref <- toJSRef a0
    mvRes <- newEmptyMVar
    Ex.bracket 
       (asyncCallback1 NeverRetain $ \aRef -> do 
          Just a <- fromJSRef aRef 
          putMVar mvRes (f a))
       release
       (\cb -> do 
          js_fooApply cb a0Ref 
	  takeMVar mvRes)

	
fooApplyInt :: (Int -> Int) -> Int -> Int
fooApplyInt f x = unsafePerformIO $ fooApply f x
{-# NOINLINE fooApplyInt #-}
	
main :: IO ()
main = do
  res <- fooApply (+1) 4
  print (res :: Int) -- prints 5
  print (fooApplyInt (+1) 4) -- prints 5