module Language.Javascript.JSaddle.Monad (
JSM(..)
, JSContextRef
, runJSaddle
, runJSaddle_
, catchval
, catch
) where
import Prelude hiding (catch)
import Control.Monad.Trans.Reader (runReaderT, ask, ReaderT(..))
import Language.Javascript.JSaddle.Types
(JSValueRefRef, JSValueRef, JSContextRef)
import Control.Monad.IO.Class (MonadIO(..))
#if (defined(ghcjs_HOST_OS) && 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 JSM = 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 -> JSM a) -> (JSValueRef -> JSM a) -> JSM a
catchval f catcher = do
#if (defined(ghcjs_HOST_OS) && 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_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
runJSaddle :: w -> JSM a -> IO a
runJSaddle _ f = runReaderT f ()
#else
runJSaddle :: WebView -> JSM a -> IO a
runJSaddle webView f = do
gctxt <- webViewGetMainFrame webView >>= webFrameGetGlobalContext
runReaderT f gctxt
#endif
runJSaddle_ w f = runJSaddle w f >> return ()