module Language.Javascript.JSC.Monad (
JSC(..)
, JSContextRef
, runJSC
, runJSC_
, catchval
, catch
) where
import Prelude hiding (catch)
import Control.Monad.Trans.Reader (runReaderT, ask, ReaderT(..))
import Language.Javascript.JSC.Types
(JSValueRefRef, JSValueRef, JSContextRef)
import Control.Monad.IO.Class (MonadIO(..))
#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
import GHCJS.Types (isUndefined, isNull)
import GHCJS.Foreign (newArray, indexArray)
#else
import Foreign (nullPtr, alloca)
import Foreign.Storable (Storable(..))
import Graphics.UI.Gtk.WebKit.Types
(WebView(..))
import Graphics.UI.Gtk.WebKit.WebView
(webViewGetMainFrame)
import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame
(webFrameGetGlobalContext)
#endif
import qualified Control.Exception as E (Exception, catch)
type JSC = ReaderT JSContextRef IO
catch :: (MonadIO m, E.Exception e)
=> ReaderT r IO b
-> (e -> ReaderT r IO b)
-> ReaderT r m b
t `catch` c = do
r <- ask
liftIO (runReaderT t r `E.catch` \e -> runReaderT (c e) r)
catchval :: (JSValueRefRef -> JSC a) -> (JSValueRef -> JSC a) -> JSC a
catchval f catcher = do
#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
pexc <- liftIO $ newArray
result <- f pexc
exc <- liftIO $ indexArray 0 pexc
if isUndefined exc || isNull exc
then return result
else catcher exc
#else
gctxt <- ask
liftIO . alloca $ \pexc -> flip runReaderT gctxt $ do
liftIO $ poke pexc nullPtr
result <- f pexc
exc <- liftIO $ peek pexc
if exc == nullPtr
then return result
else catcher exc
#endif
#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
runJSC :: w -> JSC a -> IO a
runJSC _ f = runReaderT f ()
#else
runJSC :: WebView -> JSC a -> IO a
runJSC webView f = do
gctxt <- webViewGetMainFrame webView >>= webFrameGetGlobalContext
runReaderT f gctxt
#endif
runJSC_ w f = runJSC w f >> return ()