jsc (empty) → 0.1.1.0
raw patch · 17 files changed
+2090/−0 lines, 17 filesdep +basedep +glibdep +gtksetup-changed
Dependencies added: base, glib, gtk, gtk3, hslogger, jmacro, jsc, lens, template-haskell, text, transformers, webkit, webkit-javascriptcore, webkitgtk3, webkitgtk3-javascriptcore
Files
- LICENSE +21/−0
- Setup.lhs +6/−0
- jsc.cabal +101/−0
- src/Language/Javascript/JSC.hs +81/−0
- src/Language/Javascript/JSC/Arguments.hs +58/−0
- src/Language/Javascript/JSC/Classes.hs +52/−0
- src/Language/Javascript/JSC/Evaluate.hs +79/−0
- src/Language/Javascript/JSC/Exception.hs +35/−0
- src/Language/Javascript/JSC/JMacro.hs +43/−0
- src/Language/Javascript/JSC/Monad.hs +100/−0
- src/Language/Javascript/JSC/Object.hs +523/−0
- src/Language/Javascript/JSC/PropRef.hs +25/−0
- src/Language/Javascript/JSC/Properties.hs +196/−0
- src/Language/Javascript/JSC/String.hs +74/−0
- src/Language/Javascript/JSC/Types.hs +53/−0
- src/Language/Javascript/JSC/Value.hs +502/−0
- tests/TestJSC.hs +141/−0
+ LICENSE view
@@ -0,0 +1,21 @@+Copyright (c) 2010-2012 Hamish Mackenzie, Victor Nazarov, Luite Stegeman++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ jsc.cabal view
@@ -0,0 +1,101 @@+name: jsc+version: 0.1.1.0+cabal-version: >=1.10+license: MIT+license-file: LICENSE+maintainer: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+synopsis: High level interface for webkit-javascriptcore+description: This package provides an EDSL for calling JavaScript code using+ the JavaScriptCore engine and low level Haskell bindings+ in the webkit-javascriptcore library <https://github.com/ghcjs/webkit-javascriptcore>.+author: Hamish Mackenzie+data-dir: ""+category: Web, Javascript+build-type: Simple++Source-Repository head+ type: git+ location: https://github.com/ghcjs/jsc++flag gtk3+ Description: Use GTK3 rather than GTK2+ Default: True++flag jsffi+ description: Use JavaScriptFFI extension for GHCJS JavaScript output+ default: True++flag webkit+ description: Use WebKitGtk and JavaScriptCore for GHCJS output+ default: False++flag jmacro+ description: Include some JMacro support+ default: True++library+-- if impl(ghcjs) && flag(jsffi)+-- cpp-options: -DUSE_JAVASCRIPTFFI+-- build-depends: ghcjs-base++-- if !impl(ghcjs) || flag(webkit)+ if impl(ghc)+ cpp-options: -DUSE_WEBKIT+ if flag(gtk3)+ build-depends: webkitgtk3 >=0.12.5 && <0.13,+ webkitgtk3-javascriptcore >=0.12.5 && <0.13+ else+ build-depends: webkit >=0.12.5 && <0.13,+ webkit-javascriptcore >=0.12.5 && <0.13++ if flag(jmacro)+ exposed-modules: Language.Javascript.JSC.JMacro+ build-depends: jmacro >=0.6.3 && <0.8++ build-depends: template-haskell -any, base <5, lens >=3.8.5 && <3.11,+ text >=0.11.2.3 && <0.12, transformers >=0.3.0.0 && <0.4++ exposed-modules: Language.Javascript.JSC+ Language.Javascript.JSC.Arguments Language.Javascript.JSC.Classes+ Language.Javascript.JSC.Evaluate Language.Javascript.JSC.Exception+ Language.Javascript.JSC.Monad+ Language.Javascript.JSC.Object Language.Javascript.JSC.Properties+ Language.Javascript.JSC.String Language.Javascript.JSC.Value+ Language.Javascript.JSC.Types+ exposed: True+ buildable: True+ default-language: Haskell2010+ hs-source-dirs: src+ other-modules: Language.Javascript.JSC.PropRef++test-suite test-tool+ if flag(jsffi)+ buildable: False++-- if impl(ghcjs) && flag(jsffi)+-- cpp-options: -DUSE_JAVASCRIPTFFI+-- build-depends: ghcjs-base++-- if !impl(ghcjs) || flag(webkit)+ if impl(ghc)+ cpp-options: -DUSE_WEBKIT+ build-depends: glib >=0.12.3.1 && <0.13+ if flag(gtk3)+ build-depends: gtk3 >= 0.12.4.1 && <0.13,+ webkitgtk3 >=0.12.5 && <0.13,+ webkitgtk3-javascriptcore >=0.12.5 && <0.13+ else+ build-depends: gtk >= 0.12.4.1 && <0.13,+ webkit >=0.12.5 && <0.13,+ webkit-javascriptcore >=0.12.5 && <0.13++ if flag(jmacro)+ build-depends: jmacro >=0.6.3 && <0.8++ build-depends: template-haskell -any, base <5, lens >=3.8.5 && <3.11,+ text >=0.11.2.3 && <0.12, transformers >=0.3.0.0 && <0.4,+ hslogger -any, jsc ==0.1.1.0+ type: exitcode-stdio-1.0+ main-is: TestJSC.hs+ default-language: Haskell2010+ hs-source-dirs: tests
+ src/Language/Javascript/JSC.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | This package provides an EDSL for calling JavaScript code using+-- the JavaScriptCore engine and low level Haskell bindings+-- in the webkit-javascriptcore library <https://github.com/ghcjs/webkit-javascriptcore>.+-----------------------------------------------------------------------------++module Language.Javascript.JSC (+ -- * JSC EDSL+ -- | The 'JSC' monad gives us the context for evaluation. In keeping+ -- with JavaScript the EDSL has+ --+ -- * /Weakish typing/ - type classes are used to convert to JSValueRef+ -- and JSObjectRef types+ --+ -- * /Strict evaluation/ - function in the 'JSC' monad can be passed in+ -- place of a value and will evaluated and converted to JSValueRef or+ -- JSObjectRef and then passed on to JavaScript+ --+ -- JSC should be used to write wrappers for JavaScript libraries that provide+ -- more type safety.++ -- * Code Examples+ -- | The code examples in this documentation are executed with a 'runjs'+ -- function that executes the example code in the JSC monad and converts+ -- the result to 'Text' with 'valToText'. It also catches unhandled+ -- exceptions with 'catch'. The source code can be found in tests/TestJSC.hs+ --+ -- Where it makes sense code examples are given in two forms. One+ -- that uses 'eval' to run a purely JavaScript version and one that+ -- uses more of the JSC EDSL feature being demonstated.++ -- * Calling Haskell from JavaScript+ -- | You can call back into haskell from JavaScript using 'fun' to+ -- convert a Haskell function in the JSC monad into a javascript+ -- value.++ -- * JMacro Support+ -- | If you want a more JavaScript like syntax we also have a+ -- JMacro based QuasiQuoter 'evalJM'. This converts your JMacro+ -- code into a string literal and a call to @eval@ to evaluate it+ -- using JavaScriptCore.++ -- * GHCJS Support+ -- | Because it uses webkit-javascriptcore you can compile your JSC code to+ -- JavaScript using GHCJS <https://github.com/ghcjs/ghcjs> and run it+ -- in a web browser. Calls to the WebKitGTK+ JavaScriptCore C functions+ -- will be replaced with JavaScript function calls.++ -- * Modules+ module Language.Javascript.JSC.Monad+ , module Language.Javascript.JSC.Exception+ , module Language.Javascript.JSC.Value+ , module Language.Javascript.JSC.Arguments+ , module Language.Javascript.JSC.Properties+ , module Language.Javascript.JSC.Object+ , module Language.Javascript.JSC.Evaluate+#ifdef MIN_VERSION_jmacro+ , module Language.Javascript.JSC.JMacro+#endif+ , module Language.Javascript.JSC.String+) where++import Language.Javascript.JSC.Monad+import Language.Javascript.JSC.Exception+import Language.Javascript.JSC.Value+import Language.Javascript.JSC.Arguments+import Language.Javascript.JSC.Properties+import Language.Javascript.JSC.Object+import Language.Javascript.JSC.Evaluate+#ifdef MIN_VERSION_jmacro+import Language.Javascript.JSC.JMacro+#endif+import Language.Javascript.JSC.String
+ src/Language/Javascript/JSC/Arguments.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.Arguments+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- |+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.Arguments (+ MakeArgRefs(..)+) where++import Language.Javascript.JSC.Classes+ (MakeValueRef(..), MakeValueRef, MakeArgRefs(..), MakeArgRefs)+import Language.Javascript.JSC.Monad (JSC)++instance MakeArgRefs arg => MakeArgRefs (JSC arg) where+ makeArgRefs arg = arg >>= makeArgRefs++instance MakeValueRef arg => MakeArgRefs [arg] where+ makeArgRefs = mapM makeValueRef++instance (MakeValueRef arg1, MakeValueRef arg2) => MakeArgRefs (arg1, arg2) where+ makeArgRefs (arg1, arg2) = do+ rarg1 <- makeValueRef arg1+ rarg2 <- makeValueRef arg2+ return [rarg1, rarg2]++instance (MakeValueRef arg1, MakeValueRef arg2, MakeValueRef arg3) => MakeArgRefs (arg1, arg2, arg3) where+ makeArgRefs (arg1, arg2, arg3) = do+ rarg1 <- makeValueRef arg1+ rarg2 <- makeValueRef arg2+ rarg3 <- makeValueRef arg3+ return [rarg1, rarg2, rarg3]++instance (MakeValueRef arg1, MakeValueRef arg2, MakeValueRef arg3, MakeValueRef arg4) => MakeArgRefs (arg1, arg2, arg3, arg4) where+ makeArgRefs (arg1, arg2, arg3, arg4) = do+ rarg1 <- makeValueRef arg1+ rarg2 <- makeValueRef arg2+ rarg3 <- makeValueRef arg3+ rarg4 <- makeValueRef arg4+ return [rarg1, rarg2, rarg3, rarg4]++instance (MakeValueRef arg1, MakeValueRef arg2, MakeValueRef arg3, MakeValueRef arg4, MakeValueRef arg5) => MakeArgRefs (arg1, arg2, arg3, arg4, arg5) where+ makeArgRefs (arg1, arg2, arg3, arg4, arg5) = do+ rarg1 <- makeValueRef arg1+ rarg2 <- makeValueRef arg2+ rarg3 <- makeValueRef arg3+ rarg4 <- makeValueRef arg4+ rarg5 <- makeValueRef arg5+ return [rarg1, rarg2, rarg3, rarg4, rarg5]+
+ src/Language/Javascript/JSC/Classes.hs view
@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.Classes+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | These classes are used to make various JavaScriptCore types+-- out of whatever we have. Functions in jsc take these as inputs.+-- This alows implicit casting and eager evaluation.+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.Classes (+ -- * Type classes to convert Haskell data to JavaScript+ MakeValueRef(..)+ , MakeStringRef(..)+ , MakeArgRefs(..)+ , MakeObjectRef(..)+ , MakePropRef(..)+) where++import Control.Monad.IO.Class (MonadIO)+import Language.Javascript.JSC.Types+ (JSObjectRef, JSStringRef, JSValueRef)+import Language.Javascript.JSC.Monad (JSC)+import Language.Javascript.JSC.PropRef (JSPropRef)++-- | Anything that can be used to make a JavaScript value reference+class MakeValueRef a where+ makeValueRef :: a -> JSC JSValueRef++-- | Anything that can be used to make a JavaScript string reference+class MakeStringRef a where+ makeStringRef :: a -> JSStringRef++-- | Anything that can be used to make a list of JavaScript value+-- references for use as function arguments+class MakeArgRefs this where+ makeArgRefs :: this -> JSC [JSValueRef]++-- | Anything that can be used to make a JavaScript object reference+class MakeObjectRef this where+ makeObjectRef :: this -> JSC JSObjectRef++-- | Anything that can be used to make a JavaScript property reference+class MakePropRef this where+ makePropRef :: this -> JSC JSPropRef+++
+ src/Language/Javascript/JSC/Evaluate.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE CPP #-}+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}+#endif+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.Evaluate+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | If you just want to run some JavaScript that you have as a string this is+-- you can use 'eval' or 'evaluateScript'.+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.Evaluate (+ evaluateScript+ , eval+) where++import Control.Monad.Trans.Reader (ask)+import Control.Monad.IO.Class (MonadIO(..))+import Language.Javascript.JSC.Types+ (JSStringRef, JSValueRef, JSObjectRef,+ JSValueRefRef)+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+import GHCJS.Types (nullRef)+#else+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase+ (jsevaluatescript)+import Foreign (nullPtr)+#endif+import Language.Javascript.JSC.Exception (rethrow)+import Language.Javascript.JSC.Value ()+import Language.Javascript.JSC.Object ()+import Language.Javascript.JSC.Classes+ (MakeObjectRef(..), MakeStringRef(..))+import Language.Javascript.JSC.Monad (JSC)+++-- | Evaluates a script (like eval in java script). Unlike 'eval' this function lets you+-- specify a source URL and starting line number for beter error information.+--+-- >>> testJSC $ (evaluateScript "\n\n{" global "FileName" 53 >>= valToText) `catch` \(JSException e) -> array (e,e!"sourceURL", e!"line") >>= valToText+-- SyntaxError: Expected token '}',FileName,55+evaluateScript :: (MakeStringRef script, MakeObjectRef this, MakeStringRef url)+ => script -- ^ JavaScript to evaluate+ -> this+ -> url+ -> Int -- ^ The Line number of the first line of the script+ -> JSC JSValueRef+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+evaluateScript script this url line = liftIO $ js_eval (makeStringRef script)+foreign import javascript unsafe "$r = eval(s);"+ js_eval :: JSStringRef -> IO JSValueRef+#elif defined(USE_WEBKIT)+evaluateScript script this url line = do+ gctxt <- ask+ thisr <- makeObjectRef this+ rethrow $ liftIO . jsevaluatescript gctxt (makeStringRef script) thisr (makeStringRef url) line+#else+evaluateScript = undefined+#endif++-- | Evaluates a script (like eval in java script)+--+-- >>> testJSC $ eval "1+1"+-- 2+eval :: MakeStringRef script+ => script -- ^ JavaScript to evaluate+ -> JSC JSValueRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+eval script = evaluateScript script (nullRef::JSObjectRef) (nullRef::JSStringRef) 1+#else+eval script = evaluateScript script (nullPtr::JSObjectRef) (nullPtr::JSStringRef) 1+#endif+
+ src/Language/Javascript/JSC/Exception.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.Exception+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- |+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.Exception (+ JSException(..)+ , rethrow+) where++import qualified Control.Exception as E (throwIO, Exception)+import Language.Javascript.JSC.Types+ (JSValueRefRef, JSValueRef)+import Data.Typeable (Typeable)+import Language.Javascript.JSC.Monad (catchval, JSC)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Text (Text)++data JSException = JSException JSValueRef deriving (Show, Typeable)++instance E.Exception JSException++-- | Catch JavaScript exceptions and rethrow Haskell ones+rethrow :: (JSValueRefRef -> JSC a) -> JSC a+rethrow f = f `catchval` \e -> do+ liftIO . E.throwIO $ JSException e+
+ src/Language/Javascript/JSC/JMacro.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.JMacro+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | Helper function to make it easy to embed JMacro in your code and+-- use it from JSC+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.JMacro (+ evalJM+ , evalJME+) where++import Language.Haskell.TH.Quote (QuasiQuoter(..))+import Language.Haskell.TH+ (varE, appE, Lit(..), Exp(..), mkName, ExpQ)+import Language.Javascript.JMacro (jmacro, jmacroE, renderJs)++-- | Quasi quoter that creates a JavaScript string from JMacro expression+-- and stores it in a string litteral+evalJME :: QuasiQuoter+evalJME = jmacroE {quoteExp = quoteEvalJME}++quoteEvalJME :: String -> ExpQ+quoteEvalJME s =+ appE (varE 'return) [|AppE (VarE $ mkName "Language.Javascript.JSC.eval")+ (LitE . StringL . show $ renderJs $(quoteExp jmacroE s))|]++-- | Quasi quoter that creates a JavaScript string from JMacro statement+-- and stores it in a string litteral+evalJM :: QuasiQuoter+evalJM = jmacro {quoteExp = quoteEvalJM}++quoteEvalJM :: String -> ExpQ+quoteEvalJM s =+ appE (varE 'return) [|AppE (VarE $ mkName "Language.Javascript.JSC.eval")+ (LitE . StringL . show $ renderJs $(quoteExp jmacro s))|]
+ src/Language/Javascript/JSC/Monad.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.Monad+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | JSC monad keeps track of the JavaScript context+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.Monad (+ -- * Types+ JSC(..)+ , JSContextRef++ -- * Running JSC given a DOM Window+ , runJSC+ , runJSC_++ -- * Exception Handling+ , 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)++-- | The @JSC@ monad keeps track of the JavaScript context.+--+-- Given a @JSC@ function and a 'JSContextRef' you can run the+-- function like this...+--+-- > runReaderT jscFunction javaScriptContext+--+-- For an example of how to set up WebKitGTK+ see tests/TestJSC.hs+type JSC = ReaderT JSContextRef IO++-- | Wrapped version of 'E.catch' that runs in a MonadIO that works+-- a bit better with 'JSC'+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)++-- | Handle JavaScriptCore functions that take a JSValueRefRef in order+-- to throw exceptions.+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 ()
+ src/Language/Javascript/JSC/Object.hs view
@@ -0,0 +1,523 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ForeignFunctionInterface #-}+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+{-# LANGUAGE JavaScriptFFI #-}+#endif+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.Object+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | Interface to JavaScript object+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.Object (+ JSObjectRef+ , MakeObjectRef(..)++ -- * Property lookup+ , (!)+ , (!!)+ , js+ , JSF(..)+ , jsf+ , js0+ , js1+ , js2+ , js3+ , js4+ , js5+ , jsg++ -- * Setting the value of a property+ , (<#)++ -- * Calling JavaSctipt+ , (#)+ , new+ , call+ , obj++ -- * Calling Haskell From JavaScript+ , function+ , fun+ , JSCallAsFunction(..)+ -- ** Object Constructors++ -- | There is no good way to support calling haskell code as a JavaScript+ -- constructor for the same reason that the return type of+ -- 'JSCallAsFunction' is 'JSUndefined'.+ --+ -- Instead of writing a constructor in Haskell write a function+ -- that takes a continuation. Create the JavaScript object+ -- and pass it to the continuation.++ -- * Arrays+ , array++ -- * Global Object+ , global++ -- * Enumerating Properties+ , propertyNames++ -- * Low level+ , objCallAsFunction+ , objCallAsConstructor+) where++import Prelude hiding ((!!))+import Language.Javascript.JSC.Types+ (JSPropertyNameArrayRef, JSStringRef, JSObjectRef, JSValueRefRef,+ JSValueRef, JSContextRef, Index)+import Foreign.C.Types (CSize(..), CULong(..), CUInt(..))+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+import GHCJS.Types (nullRef, castRef, JSArray, JSFun)+import GHCJS.Foreign (newObj, toArray, fromArray, syncCallback2)+import Control.Monad (liftM)+import Control.Applicative ((<$>))+#else+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef+ (jsobjectmake, jspropertynamearraygetnameatindex,+ jspropertynamearraygetcount, jsobjectcopypropertynames,+ jsobjectsetpropertyatindex, jsobjectgetpropertyatindex,+ jsobjectcallasconstructor, jsobjectmakearray,+ jsobjectcallasfunction, jsobjectgetproperty, jsobjectsetproperty,+ JSPropertyAttributes, JSObjectCallAsFunctionCallback,+ jsobjectmakefunctionwithcallback, JSObjectCallAsFunctionCallback')+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef+ (jsvaluemakeundefined)+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef+ (jscontextgetglobalobject)+import Foreign (peekArray, nullPtr, withArrayLen)+#endif+import Language.Javascript.JSC.Exception (rethrow)+import Language.Javascript.JSC.Value+ (JSUndefined, valMakeUndefined, valToObject)+import Language.Javascript.JSC.PropRef (JSPropRef(..))+import Language.Javascript.JSC.Classes+ (MakeValueRef(..), MakeStringRef(..), MakeArgRefs(..), MakePropRef(..),+ MakeObjectRef(..))+import Language.Javascript.JSC.Monad+ (JSC)+import Control.Monad.Trans.Reader (runReaderT, ask)+import Control.Monad.IO.Class (MonadIO(..))+import qualified Control.Exception as E (catch)+import Control.Exception (SomeException)+import qualified Data.Text as T (pack)+import Foreign.Storable (Storable(..))+import Language.Javascript.JSC.Properties+import Control.Lens+ (IndexPreservingGetter, to, (^.))+import Language.Javascript.JSC.String (textToStr)++-- | If we already have a JSObjectRef we are fine+instance MakeObjectRef JSObjectRef where+ makeObjectRef = return++-- | JSObjectRef can be made by evaluating a function in 'JSC' as long+-- as it returns something we can make into a JSObjectRef.+instance MakeObjectRef v => MakeObjectRef (JSC v) where+ makeObjectRef v = v >>= makeObjectRef++-- | Lookup a property based on its name. This function just constructs a JSPropRef+-- the lookup is delayed until we use the JSPropRef. This makes it a bit lazy compared+-- to JavaScript's @.@ operator.+--+-- >>> testJSC $ eval "'Hello World'.length"+-- >>> testJSC $ val "Hello World" ! "length"+-- 11+(!) :: (MakeObjectRef this, MakeStringRef name)+ => this -- ^ Object to look on+ -> name -- ^ Name of the property to find+ -> JSC JSPropRef -- ^ Property reference+this ! name = do+ rthis <- makeObjectRef this+ return (JSPropRef rthis rname)+ where+ rname = makeStringRef name++-- | Lookup a property based on its index. This function just constructs a JSPropRef+-- the lookup is delayed until we use the JSPropRef. This makes it a bit lazy compared+-- to JavaScript's @[]@ operator.+--+-- >>> testJSC $ eval "'Hello World'[6]"+-- >>> testJSC $ val "Hello World" !! 6+-- W+(!!) :: (MakeObjectRef this)+ => this -- ^ Object to look on+ -> Index -- ^ Index of the property to lookup+ -> JSC JSPropRef -- ^ Property reference+this !! index = do+ rthis <- makeObjectRef this+ return (JSPropIndexRef rthis index)++-- | Makes a getter for a particular property name.+--+-- > js name = to (!name)+--+-- >>> testJSC $ eval "'Hello World'.length"+-- >>> testJSC $ val "Hello World" ^. js "length"+-- 11+js :: (MakeObjectRef s, MakeStringRef name)+ => name -- ^ Name of the property to find+ -> IndexPreservingGetter s (JSC JSPropRef)+js name = to (!name)++-- | Java script function applications have this type+type JSF = MakeObjectRef o => IndexPreservingGetter o (JSC JSValueRef)++-- | Handy way to call a function+--+-- > jsf name = js name . to (# args)+--+-- >>> testJSC $ val "Hello World" ^. jsf "indexOf" ["World"]+-- 6+jsf :: (MakeStringRef name, MakeArgRefs args) => name -> args -> JSF+jsf name args = function . to (# args)+ where+ function = js name++-- | Handy way to call a function that expects no arguments+--+-- > js0 name = jsf name ()+--+-- >>> testJSC $ val "Hello World" ^. js0 "toLowerCase"+-- hello world+js0 :: (MakeStringRef name) => name -> JSF+js0 name = jsf name ()++-- | Handy way to call a function that expects one argument+--+-- > js1 name a0 = jsf name [a0]+--+-- >>> testJSC $ val "Hello World" ^. js1 "indexOf" "World"+-- 6+js1 :: (MakeStringRef name, MakeValueRef a0) => name -> a0 -> JSF+js1 name a0 = jsf name [a0]++-- | Handy way to call a function that expects two arguments+js2 :: (MakeStringRef name, MakeValueRef a0, MakeValueRef a1) => name -> a0 -> a1 -> JSF+js2 name a0 a1 = jsf name (a0, a1)++-- | Handy way to call a function that expects three arguments+js3 :: (MakeStringRef name, MakeValueRef a0, MakeValueRef a1, MakeValueRef a2)+ => name -> a0 -> a1 -> a2 -> JSF+js3 name a0 a1 a2 = jsf name (a0, a1, a2)++-- | Handy way to call a function that expects four arguments+js4 :: (MakeStringRef name, MakeValueRef a0, MakeValueRef a1, MakeValueRef a2,+ MakeValueRef a3)+ => name -> a0 -> a1 -> a2 -> a3 -> JSF+js4 name a0 a1 a2 a3 = jsf name (a0, a1, a2, a3)++-- | Handy way to call a function that expects five arguments+js5 :: (MakeStringRef name, MakeValueRef a0, MakeValueRef a1, MakeValueRef a2,+ MakeValueRef a3, MakeValueRef a4)+ => name -> a0 -> a1 -> a2 -> a3 -> a4 -> JSF+js5 name a0 a1 a2 a3 a4 = jsf name (a0, a1, a2, a3, a4)+++-- | Handy way to get and hold onto a reference top level javascript+--+-- >>> testJSC $ eval "w = console; w.log('Hello World')"+-- >>> testJSC $ do w <- jsg "console"; w ^. js "log" # ["Hello World"]+-- 11+jsg :: MakeStringRef a => a -> JSC JSPropRef+jsg name = global ! name++-- | Call a JavaScript function+--+-- >>> testJSC $ eval "'Hello World'.indexOf('World')"+-- >>> testJSC $ val "Hello World" ! "indexOf" # ["World"]+-- 6+infixr 2 #+(#) :: (MakePropRef prop, MakeArgRefs args)+ => prop -> args -> JSC JSValueRef+prop # args = do+ rprop <- makePropRef prop+ (this, f) <- objGetProperty' rprop+ rethrow $ objCallAsFunction f this args++-- | Call a JavaScript function+--+-- >>> testJSC $ eval "var j = {}; j.x = 1; j.x"+-- >>> testJSC $ do {j <- eval "({})"; j!"x" <# 1; j!"x"}+-- 1+infixr 0 <#+(<#) :: (MakePropRef prop, MakeValueRef val)+ => prop -- ^ Property to set+ -> val -- ^ Value to set it to+ -> JSC JSPropRef -- ^ Reference to the property set+prop <# val = do+ p <- makePropRef prop+ objSetProperty p val+ return p++-- | Use this to create a new JavaScript object+--+-- >>> testJSC $ new "Date" (2013, 1, 1)+-- Fri Feb 01 2013 00:00:00 GMT+1300 (NZDT)+new :: (MakeObjectRef constructor, MakeArgRefs args)+ => constructor+ -> args+ -> JSC JSValueRef+new constructor args = do+ f <- makeObjectRef constructor+ rethrow $ objCallAsConstructor f args++-- | Call function with a given @this@. In most cases you should use '#'.+--+-- >>> testJSC $ eval "(function(){return this;}).apply('Hello', [])"+-- >>> testJSC $ do { test <- eval "(function(){return this;})"; call test (val "Hello") () }+-- Hello+call :: (MakeObjectRef function, MakeObjectRef this, MakeArgRefs args)+ => function -> this -> args -> JSC JSValueRef+call function this args = do+ rfunction <- makeObjectRef function+ rthis <- makeObjectRef this+ rethrow $ objCallAsFunction rfunction rthis args++-- | Make an empty object using the default constuctor+--+-- >>> testJSC $ eval "var a = {}; a.x = 'Hello'; a.x"+-- >>> testJSC $ do { a <- obj; a ^. js "x" <# "Hello"; a ^. js "x" }+-- Hello+obj :: JSC JSObjectRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+obj = liftIO $ newObj+#else+obj = do+ gctxt <- ask+ liftIO $ jsobjectmake gctxt nullPtr nullPtr+#endif++-- | Type used for Haskell functions called from JavaScript.+type JSCallAsFunction = JSValueRef -- ^ Function object+ -> JSValueRef -- ^ this+ -> [JSValueRef] -- ^ Function arguments+ -> JSC JSUndefined -- ^ Only 'JSUndefined' can be returned because+ -- the function may need to be executed in a+ -- different thread. If you need to get a+ -- value out pass in a continuation function+ -- as an argument and invoke it from haskell.++-- | Short hand @::JSCallAsFunction@ so a haskell function can be passed to+-- a to a JavaScipt one.+--+-- >>> testJSC $ eval "(function(f) {f('Hello');})(function (a) {console.log(a)})"+-- >>> testJSC $ call (eval "(function(f) {f('Hello');})") global [fun $ \ _ _ args -> valToText (head args) >>= (liftIO . putStrLn . T.unpack) ]+-- Hello+-- undefined+fun :: JSCallAsFunction -> JSCallAsFunction+fun = id++#if (!defined(__GHCJS__) || !defined(USE_JAVASCRIPTFFI)) && defined(USE_WEBKIT)+foreign import ccall "wrapper"+ mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback+#endif++-- ^ Make a JavaScript function object that wraps a Haskell function.+function :: MakeStringRef name+ => name -- ^ Name of the function+ -> JSCallAsFunction -- ^ Haskell function to call+ -> JSC JSObjectRef -- ^ Returns a JavaScript function object that will+ -- call the Haskell one when it is called+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+function name f = liftIO $ do+ callback <- syncCallback2 False True $ \this args -> do+ rargs <- fromArray args+ runReaderT (f this this rargs) () -- TODO pass function object through+ makeFunctionWithCallback (makeStringRef name) callback+foreign import javascript unsafe "$r = function () { $2(this, arguments); }"+ makeFunctionWithCallback :: JSStringRef -> JSFun (JSValueRef -> JSValueRefRef -> IO ()) -> IO JSObjectRef+#elif defined(USE_WEBKIT)+function name f = do+ gctxt <- ask+ callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap+ liftIO $ jsobjectmakefunctionwithcallback gctxt (makeStringRef name) callback+ where+ wrap ctx fobj this argc argv exception = do+ args <- peekArray (fromIntegral argc) argv+ (`runReaderT` ctx) $+ f fobj this args >>= makeValueRef+ `E.catch` \(e :: SomeException) -> do+ str <- runReaderT (makeValueRef . T.pack $ show e) ctx+ poke exception str+ jsvaluemakeundefined ctx+#else+function = undefined+#endif++-- | A callback to Haskell can be used as a JavaScript value. This will create+-- an anonymous JavaScript function object. Use 'function' to create one with+-- a name.+instance MakeValueRef JSCallAsFunction where+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+ makeValueRef = function (nullRef::JSStringRef)+#else+ makeValueRef = function (nullPtr::JSStringRef)+#endif++instance MakeArgRefs JSCallAsFunction where+ makeArgRefs f = do+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+ rarg <- function (nullRef::JSStringRef) f+#else+ rarg <- function (nullPtr::JSStringRef) f+#endif+ return [rarg]++makeArray :: MakeArgRefs args => args -> JSValueRefRef -> JSC JSObjectRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+makeArray args exceptions = makeArgRefs args >>= liftM castRef . liftIO . toArray+#else+makeArray args exceptions = do+ gctxt <- ask+ rargs <- makeArgRefs args+ liftIO $ withArrayLen rargs $ \ len ptr ->+ jsobjectmakearray gctxt (fromIntegral len) ptr exceptions+#endif++-- | Make an JavaScript array from a list of values+--+-- >>> testJSC $ eval "['Hello', 'World'][1]"+-- >>> testJSC $ array ["Hello", "World"] !! 1+-- World+-- >>> testJSC $ eval "['Hello', null, undefined, true, 1]"+-- >>> testJSC $ array ("Hello", JSNull, (), True, 1.0::Double)+-- Hello,,,true,1+array :: MakeArgRefs args => args -> JSC JSObjectRef+array = rethrow . makeArray++-- | JavaScript's global object+global :: JSC JSObjectRef+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+global = liftIO js_window+foreign import javascript unsafe "$r = window"+ js_window :: IO JSObjectRef+#elif defined(USE_WEBKIT)+global = ask >>= (liftIO . jscontextgetglobalobject)+#else+global = undefined+#endif++-- | Get an array containing the property names present on a given object+#if (!defined(__GHCJS__) || !defined(USE_JAVASCRIPTFFI)) && defined(USE_WEBKIT)+copyPropertyNames :: MakeObjectRef this => this -> JSC JSPropertyNameArrayRef+copyPropertyNames this = do+ gctxt <- ask+ rthis <- makeObjectRef this+ liftIO $ jsobjectcopypropertynames gctxt rthis++-- | Get the number of names in a property name array+propertyNamesCount :: MonadIO m => JSPropertyNameArrayRef -> m CSize+propertyNamesCount names = liftIO $ jspropertynamearraygetcount names++-- | Get a name out of a property name array+propertyNamesAt :: MonadIO m => JSPropertyNameArrayRef -> CSize -> m JSStringRef+propertyNamesAt names index = liftIO $ jspropertynamearraygetnameatindex names index++-- | Convert property array to a list+propertyNamesList :: MonadIO m => JSPropertyNameArrayRef -> m [JSStringRef]+propertyNamesList names = do+ count <- propertyNamesCount names+ mapM (propertyNamesAt names) $ enumFromTo 0 (count - 1)+#endif++-- | Get a list containing the property names present on a given object+propertyNames :: MakeObjectRef this => this -> JSC [JSStringRef]+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+propertyNames this = makeObjectRef this >>= liftIO . js_propertyNames >>= liftIO . fromArray+foreign import javascript unsafe "$r = []; h$forIn($1, function(n){$r.push(n);})"+ js_propertyNames :: JSObjectRef -> IO (JSArray a)+#elif defined(USE_WEBKIT)+propertyNames this = copyPropertyNames this >>= propertyNamesList+#else+propertyNames = undefined+#endif++-- | Get a list containing references to all the properties present on a given object+properties :: MakeObjectRef this => this -> JSC [JSPropRef]+properties this = propertyNames this >>= mapM (this !)++-- | Call a JavaScript object as function. Consider using '#'.+objCallAsFunction :: MakeArgRefs args+ => JSObjectRef+ -> JSObjectRef+ -> args+ -> JSValueRefRef+ -> JSC JSValueRef+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+objCallAsFunction function this args exceptions = do+ rargs <- makeArgRefs args >>= liftIO . toArray+ liftIO $ js_apply function this rargs exceptions+foreign import javascript unsafe "try { $r = $1.apply($2, $3) } catch(e) { $4[0] = e }"+ js_apply :: JSObjectRef -> JSObjectRef -> JSValueRefRef -> JSValueRefRef -> IO JSValueRef+#elif defined(USE_WEBKIT)+objCallAsFunction function this args exceptions = do+ gctxt <- ask+ rargs <- makeArgRefs args+ liftIO $ withArrayLen rargs $ \ largs pargs ->+ jsobjectcallasfunction gctxt function this (fromIntegral largs) pargs exceptions+#else+objCallAsFunction = undefined+#endif++-- | Call a JavaScript object as a constructor. Consider using 'new'.+objCallAsConstructor :: MakeArgRefs args+ => JSObjectRef+ -> args+ -> JSValueRefRef+ -> JSC JSValueRef+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+objCallAsConstructor function args exceptions = do+ rargs <- makeArgRefs args >>= liftIO . toArray+ liftIO $ js_new function rargs exceptions+foreign import javascript unsafe "\+ try {\+ switch($2.length) {\+ case 0 : $r = new $1();\+ case 1 : $r = new $1($2[0]);\+ case 2 : $r = new $1($2[0],$2[1]);\+ case 3 : $r = new $1($2[0],$2[1],$2[2]);\+ case 4 : $r = new $1($2[0],$2[1],$2[2],$2[3]);\+ case 5 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4]);\+ case 6 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4],$2[5]);\+ case 6 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4],$2[5],$2[6]);\+ default:\+ var ret;\+ var temp = function() {\+ ret = $1.apply(this, $2);\+ };\+ temp.prototype = f.prototype;\+ var i = new temp();\+ $r = ret instanceof Object ? ret : i;\+ }\+ }\+ catch(e) {\+ $3[0] = e;\+ }"+ js_new :: JSObjectRef -> JSValueRefRef -> JSValueRefRef -> IO JSValueRef+#elif defined(USE_WEBKIT)+objCallAsConstructor function args exceptions = do+ gctxt <- ask+ rargs <- makeArgRefs args+ liftIO $ withArrayLen rargs $ \ largs pargs ->+ jsobjectcallasconstructor gctxt function (fromIntegral largs) pargs exceptions+#else+objCallAsConstructor = undefined+#endif+++++
+ src/Language/Javascript/JSC/PropRef.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.PropRef+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | Implements a reference to a property+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.PropRef (+ JSPropRef(..)+) where++import Language.Javascript.JSC.Types+ (JSStringRef, JSObjectRef, Index)++-- | A reference to a property.+-- Implemented as a reference to an object and something to find the property.+data JSPropRef = JSPropRef JSObjectRef JSStringRef -- ^ Object and property name.+ | JSPropIndexRef JSObjectRef Index -- ^ Object and property index.++
+ src/Language/Javascript/JSC/Properties.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}+#endif+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.Properties+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | Low level JavaScript object property access. In most cases you+-- should use "Language.Javascript.JSC.Object" instead.+--+-- This module is mostly here to implement functions needed to use+-- 'JSPropRef'.+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.Properties (+ -- * Propery Reference+ JSPropRef(..)+ , MakePropRef(..)++ -- * Getting Property Values+ , objGetPropertyByName+ , objGetPropertyAtIndex+ , objGetProperty+ , objGetProperty'+ -- * Setting Property Values+ , objSetPropertyByName+ , objSetPropertyAtIndex+ , objSetProperty+) where++import Control.Applicative ((<$>))+import Language.Javascript.JSC.PropRef (JSPropRef(..))+import Language.Javascript.JSC.Classes+ (MakePropRef(..), MakeObjectRef(..), MakeValueRef(..),+ MakeArgRefs(..), MakeStringRef(..))+import Language.Javascript.JSC.Monad (JSC)+import Language.Javascript.JSC.Types+ (JSValueRefRef, JSObjectRef, JSPropertyAttributes,+ Index(..), JSStringRef)+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+#else+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef+ (jsobjectgetpropertyatindex, jsobjectgetproperty,+ jsobjectsetpropertyatindex, jsobjectsetproperty,+ JSPropertyAttributes)+#endif+import Control.Monad.Trans.Reader (ask)+import Control.Monad.IO.Class (MonadIO(..))+import Language.Javascript.JSC.Exception (rethrow)+import Language.Javascript.JSC.Value (JSValueRef)+import Language.Javascript.JSC.Arguments ()+import Language.Javascript.JSC.String ()++-- | If we already have a JSPropRef we are fine+instance MakePropRef JSPropRef where+ makePropRef = return++-- | JSPropRef can be made by evaluating a function in 'JSC' as long+-- as it returns something we can make into a JSPropRef.+instance MakePropRef prop => MakePropRef (JSC prop) where+ makePropRef prop = prop >>= makePropRef++-- | We can use a property as an object.+instance MakeObjectRef JSPropRef where+ makeObjectRef = objGetProperty++-- | We can use a property as a value.+instance MakeValueRef JSPropRef where+ makeValueRef = objGetProperty++-- | We can pass a property as the only paramter to a function.+instance MakeArgRefs JSPropRef where+ makeArgRefs p = do+ rarg <- objGetProperty p+ return [rarg]++-- | Get a property value given the object and the name of the property.+objGetPropertyByName :: MakeStringRef name+ => JSObjectRef -- ^ object to find the property on.+ -> name -- ^ name of the property.+ -> JSValueRefRef -- ^ exception if one is raised.+ -> JSC JSValueRef -- ^ returns the property value.+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+objGetPropertyByName this name = liftIO . js_tryGetProp (makeStringRef name) this+foreign import javascript unsafe "try { $r=$2[$1] } catch(e) { $3[0] = e }"+ js_tryGetProp :: JSStringRef -> JSObjectRef -> JSValueRefRef -> IO JSValueRef+#elif defined(USE_WEBKIT)+objGetPropertyByName this name exceptions = do+ gctxt <- ask+ liftIO $ jsobjectgetproperty gctxt this (makeStringRef name) exceptions+#else+objGetPropertyByName = undefined+#endif++-- | Get a property value given the object and the index of the property.+objGetPropertyAtIndex :: JSObjectRef -- ^ object to find the property on.+ -> Index -- ^ index of the property.+ -> JSValueRefRef -- ^ exception if one is raised.+ -> JSC JSValueRef -- ^ returns the property value.+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+objGetPropertyAtIndex this index = liftIO . js_tryIndex index this+foreign import javascript unsafe "try { $r=$2[$1] } catch(e) { $3[0] = e }"+ js_tryIndex :: Index -> JSObjectRef -> JSValueRefRef -> IO JSValueRef+#elif defined(USE_WEBKIT)+objGetPropertyAtIndex this index exceptions = do+ gctxt <- ask+ liftIO $ jsobjectgetpropertyatindex gctxt this index exceptions+#else+objGetPropertyAtIndex = undefined+#endif++-- | Gets the value of a property given a 'JSPropRef'.+objGetProperty :: JSPropRef -- ^ property reference.+ -> JSC JSValueRef -- ^ returns the property value.+objGetProperty (JSPropRef this name ) =+ rethrow $ objGetPropertyByName this name+objGetProperty (JSPropIndexRef this index) =+ rethrow $ objGetPropertyAtIndex this index++-- | This version of 'objGetProperty' is handy when you also need to perform.+-- another operation on the object the property is on.+objGetProperty' :: JSPropRef -- ^ property reference.+ -> JSC (JSObjectRef, JSValueRef) -- ^ returns the object and property value.+objGetProperty' (JSPropRef this name) = do+ p <- rethrow $ objGetPropertyByName this name+ return (this, p)+objGetProperty' (JSPropIndexRef this index) = do+ p <- rethrow $ objGetPropertyAtIndex this index+ return (this, p)+++-- | Set a property value given the object and the name of the property.+objSetPropertyByName :: (MakeStringRef name, MakeValueRef val)+ => JSObjectRef -- ^ object to set the property on.+ -> name -- ^ name of the property.+ -> val -- ^ new value to set the property to.+ -> JSPropertyAttributes -- ^ property attributes to give the property.+ -> JSValueRefRef -- ^ exception if one is raised.+ -> JSC ()+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+objSetPropertyByName this name val attributes exceptions = do+ vref <- makeValueRef val+ liftIO $ js_trySetProp (makeStringRef name) this vref exceptions+foreign import javascript unsafe "try { $2[$1]=$3 } catch(e) { $4[0] = e }"+ js_trySetProp :: JSStringRef -> JSObjectRef -> JSValueRef -> JSValueRefRef -> IO ()+#elif defined(USE_WEBKIT)+objSetPropertyByName this name val attributes exceptions = do+ gctxt <- ask+ vref <- makeValueRef val+ liftIO $ jsobjectsetproperty gctxt this (makeStringRef name) vref attributes exceptions+#else+objSetPropertyByName = undefined+#endif++-- | Set a property value given the object and the index of the property.+objSetPropertyAtIndex :: (MakeValueRef val)+ => JSObjectRef -- ^ object to find property on.+ -> Index -- ^ index of the property.+ -> val -- ^ new value to set the property to.+ -> JSValueRefRef -- ^ exception if one is raised.+ -> JSC ()+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+objSetPropertyAtIndex this index val exceptions = do+ vref <- makeValueRef val+ liftIO $ js_trySetAtIndex index this vref exceptions+foreign import javascript unsafe "try { $2[$1]=$3 } catch(e) { $4[0] = e }"+ js_trySetAtIndex :: Index -> JSObjectRef -> JSValueRef -> JSValueRefRef -> IO ()+#elif defined(USE_WEBKIT)+objSetPropertyAtIndex this index val exceptions = do+ gctxt <- ask+ vref <- makeValueRef val+ liftIO $ jsobjectsetpropertyatindex gctxt this index vref exceptions+#else+objSetPropertyAtIndex = undefined+#endif++-- | Sets the value of a property given a 'JSPropRef'.+objSetProperty :: (MakeValueRef val)+ => JSPropRef -- ^ property reference.+ -> val -- ^ new value to set the property to.+ -> JSC ()+objSetProperty (JSPropRef this name ) val = rethrow $ objSetPropertyByName this name val 0+objSetProperty (JSPropIndexRef this index) val = rethrow $ objSetPropertyAtIndex this index val+++++
+ src/Language/Javascript/JSC/String.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.String+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | JavaScript string conversion functions+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.String (+ JSStringRef+ , MakeStringRef(..)++ -- * Data.Text helpers+ , strToText+ , textToStr+) where++import Data.Text (Text)+import qualified Data.Text as T (pack)+import Control.Monad.IO.Class (MonadIO(..))+import Language.Javascript.JSC.Types (JSStringRef)+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+import GHCJS.Foreign (fromJSString, toJSString)+#else+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef+ (jsstringcreatewithcharacters, jsstringgetcharactersptr,+ jsstringgetlength)+#endif+import qualified Data.Text.Foreign as T (fromPtr)+import Foreign (castPtr)+import Data.Text.Foreign (useAsPtr)+import Language.Javascript.JSC.Classes (MakeStringRef(..))+import System.IO.Unsafe (unsafePerformIO)++-- | If we already have a JSStringRef we are fine+instance MakeStringRef JSStringRef where+ makeStringRef = id++instance MakeStringRef Text where+ makeStringRef = textToStr++instance MakeStringRef String where+ makeStringRef = textToStr . T.pack++-- | Convert a JavaScript string to a Haskell 'Text'+strToText :: MonadIO m => JSStringRef -> m Text+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+strToText = return . fromJSString+#else+strToText jsstring = liftIO $ do+ l <- jsstringgetlength jsstring+ p <- jsstringgetcharactersptr jsstring+ T.fromPtr (castPtr p) (fromIntegral l)+#endif++-- | Convert a Haskell 'Text' to a JavaScript string+textToStr :: Text -> JSStringRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+textToStr = toJSString+#else+textToStr text = unsafePerformIO $+ useAsPtr text $ \p l ->+ jsstringcreatewithcharacters (castPtr p) (fromIntegral l)+#endif+++
+ src/Language/Javascript/JSC/Types.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE CPP, FlexibleInstances #-}+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.Properties+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- |+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.Types (+ JSValueRef(..)+ , JSValueRefRef(..)+ , JSObjectRef(..)+ , JSPropertyNameArrayRef(..)+ , JSPropertyAttributes(..)+ , JSContextRef(..)+ , JSStringRef(..)+ , Index(..)+) where++#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+import GHCJS.Types+import Data.Word (Word(..))+#else+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase+ (JSValueRef, JSValueRefRef, JSObjectRef, JSStringRef,+ JSContextRef, JSPropertyNameArrayRef)+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef (JSPropertyAttributes)+import Foreign.C (CUInt(..))+#endif++#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+data ValueOrObject+data Object+data PropertyNameArray+type JSValueRef = JSRef ValueOrObject+type JSValueRefRef = JSArray ValueOrObject+type JSObjectRef = JSRef ValueOrObject+type JSPropertyNameArrayRef = JSRef PropertyNameArray+type JSPropertyAttributes = Word+type JSContextRef = ()+type JSStringRef = JSString+type Index = Int++instance Show (JSRef ValueOrObject)+instance Eq (JSRef ValueOrObject)+#else+type Index = CUInt+#endif
+ src/Language/Javascript/JSC/Value.hs view
@@ -0,0 +1,502 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}+#endif+-----------------------------------------------------------------------------+--+-- Module : Language.Javascript.JSC.Value+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | Deals with JavaScript values. These can be+--+-- * null+--+-- * undefined+--+-- * true | false+--+-- * a double precision floating point number+--+-- * a string+--+-- * an object+--+-----------------------------------------------------------------------------++module Language.Javascript.JSC.Value (+ -- * JavaScript value references+ JSValueRef+ , MakeValueRef(..)++ -- * Haskell types for JavaScript values+ , JSNull(..)+ , JSUndefined(..)+ , JSBool(..)+ , JSNumber(..)+ , JSString(..)+ , JSValue(..)++ -- * Converting JavaScript values+ , valToBool+ , valToNumber+ , valToStr+ , valToObject+ , valToText+ , valToJSON++ -- * Make JavaScript values from Haskell ones+ , val+ , valMakeNull+ , valMakeUndefined+ , valMakeBool+ , valMakeNumber+ , valMakeString++ -- * Conver to and from JSValue+ , deRefVal+ , valMakeRef+) where++import Prelude hiding (catch)+import Language.Javascript.JSC.Types+ (JSValueRefRef, JSObjectRef, JSStringRef, JSValueRef)+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+import GHCJS.Types (castRef, JSRef(..))+import GHCJS.Foreign (toJSBool, fromJSBool', jsNull, jsUndefined, toJSString)+import GHCJS.Marshal (toJSRef)+#else+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef+ (jsvaluecreatejsonstring, JSType(..), jsvaluegettype,+ jsvaluemakestring, jsvaluemakenumber, jsvaluemakeboolean,+ jsvaluemakeundefined, jsvaluemakenull, jsvaluetoobject,+ jsvaluetostringcopy, jsvaluetonumber, jsvaluetoboolean)+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef+ (jsstringcreatewithcharacters, jsstringgetcharactersptr,+ jsstringgetlength)+#endif+import Language.Javascript.JSC.Monad (JSC, catchval)+import Language.Javascript.JSC.Exception (rethrow)+import Control.Monad.Trans.Reader (ask)+import Control.Monad.IO.Class (MonadIO, MonadIO(..))+import qualified Data.Text.Foreign as T (fromPtr)+import Foreign (castPtr)+import Data.Text.Foreign (useAsPtr)+import Control.Applicative ((<$>))+import Data.Text (Text)+import qualified Data.Text as T (pack)+import Language.Javascript.JSC.Classes+ (MakeObjectRef(..), MakeStringRef(..), MakeValueRef(..),+ MakeArgRefs(..))+import Language.Javascript.JSC.String (strToText, textToStr)+import Language.Javascript.JSC.Arguments ()+import Data.Word (Word)++data JSNull = JSNull -- ^ Type that represents a value that can only be null.+ -- Haskell of course has no null so we are adding this type.+type JSUndefined = () -- ^ A type that can only be undefined in JavaScript. Using ()+ -- because functions in JavaScript that have no return, impicitly+ -- return undefined.+type JSBool = Bool -- ^ JavaScript boolean values map the 'Bool' haskell type.+type JSNumber = Double -- ^ A number in JavaScript maps nicely to 'Double'.+type JSString = Text -- ^ JavaScript strings can be represented with the Haskell 'Text' type.++-- | An algebraic data type that can represent a JavaScript value. Any JavaScriptCore+-- 'JSValueRef' can be converted into this type.+data JSValue = ValNull -- ^ null+ | ValUndefined -- ^ undefined+ | ValBool JSBool -- ^ true or false+ | ValNumber JSNumber -- ^ a number+ | ValString JSString -- ^ a string+ | ValObject JSObjectRef -- ^ an object+ deriving(Show, Eq)++-- | Given a JavaScript value get its boolean value.+-- All values in JavaScript convert to bool.+--+-- >>> testJSC $ valToBool JSNull+-- false+-- >>> testJSC $ valToBool ()+-- false+-- >>> testJSC $ valToBool True+-- true+-- >>> testJSC $ valToBool False+-- false+-- >>> testJSC $ valToBool (1.0 :: Double)+-- true+-- >>> testJSC $ valToBool (0.0 :: Double)+-- false+-- >>> testJSC $ valToBool ""+-- false+-- >>> testJSC $ valToBool "1"+-- true+valToBool :: MakeValueRef val => val -> JSC JSBool+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+valToBool val = fromJSBool' <$> makeValueRef val+#else+valToBool val = do+ gctxt <- ask+ rval <- makeValueRef val+ liftIO $ jsvaluetoboolean gctxt rval+#endif++-- | Given a JavaScript value get its numeric value.+-- May throw JSException.+--+-- >>> testJSC $ show <$> valToNumber JSNull+-- 0.0+-- >>> testJSC $ show <$> valToNumber ()+-- NaN+-- >>> testJSC $ show <$> valToNumber True+-- 1.0+-- >>> testJSC $ show <$> valToNumber False+-- 0.0+-- >>> testJSC $ show <$> valToNumber (1.0 :: Double)+-- 1.0+-- >>> testJSC $ show <$> valToNumber (0.0 :: Double)+-- 0.0+-- >>> testJSC $ show <$> valToNumber ""+-- 0.0+-- >>> testJSC $ show <$> valToNumber "1"+-- 1.0+valToNumber :: MakeValueRef val => val -> JSC JSNumber+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+valToNumber val = jsrefToNumber <$> makeValueRef val+foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSRef a -> Double+#elif defined(USE_WEBKIT)+valToNumber val = do+ gctxt <- ask+ rval <- makeValueRef val+ rethrow $ liftIO . jsvaluetonumber gctxt rval+#else+valToNumber = undefined+#endif++-- | Given a JavaScript value get its string value (as a JavaScript string).+-- May throw JSException.+--+-- >>> testJSC $ valToStr JSNull >>= strToText+-- null+-- >>> testJSC $ valToStr () >>= strToText+-- undefined+-- >>> testJSC $ valToStr True >>= strToText+-- true+-- >>> testJSC $ valToStr False >>= strToText+-- false+-- >>> testJSC $ valToStr (1.0 :: Double) >>= strToText+-- 1+-- >>> testJSC $ valToStr (0.0 :: Double) >>= strToText+-- 0+-- >>> testJSC $ valToStr "" >>= strToText+--+-- >>> testJSC $ valToStr "1" >>= strToText+-- 1+valToStr :: MakeValueRef val => val -> JSC JSStringRef+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+valToStr val = jsrefToString <$> makeValueRef val+foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSRef a -> JSStringRef+#elif defined(USE_WEBKIT)+valToStr val = do+ gctxt <- ask+ rval <- makeValueRef val+ rethrow $ liftIO . jsvaluetostringcopy gctxt rval+#else+valToStr = undefined+#endif++-- | Given a JavaScript value get its string value (as a Haskell 'Text').+-- May throw JSException.+--+-- >>> testJSC $ show <$> valToText JSNull+-- "null"+-- >>> testJSC $ show <$> valToText ()+-- "undefined"+-- >>> testJSC $ show <$> valToText True+-- "true"+-- >>> testJSC $ show <$> valToText False+-- "false"+-- >>> testJSC $ show <$> valToText (1.0 :: Double)+-- "1"+-- >>> testJSC $ show <$> valToText (0.0 :: Double)+-- "0"+-- >>> testJSC $ show <$> valToText ""+-- ""+-- >>> testJSC $ show <$> valToText "1"+-- "1"+valToText :: MakeValueRef val => val -> JSC Text+valToText jsvar = valToStr jsvar >>= strToText++-- | Given a JavaScript value get a JSON string value.+-- May throw JSException.+--+-- >>> testJSC $ valToJSON 0 JSNull >>= strToText+-- null+-- >>> testJSC $ valToJSON 0 () >>= strToText+--+-- >>> testJSC $ valToJSON 0 True >>= strToText+-- true+-- >>> testJSC $ valToJSON 0 False >>= strToText+-- false+-- >>> testJSC $ valToJSON 0 (1.0 :: Double) >>= strToText+-- 1+-- >>> testJSC $ valToJSON 0 (0.0 :: Double) >>= strToText+-- 0+-- >>> testJSC $ valToJSON 0 "" >>= strToText+-- ""+-- >>> testJSC $ valToJSON 0 "1" >>= strToText+-- "1"+-- >>> testJSC $ obj >>= valToJSON 0 >>= strToText+-- {}+valToJSON :: MakeValueRef val => Word -> val -> JSC JSStringRef+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+valToJSON indent val = jsrefToJSON <$> makeValueRef val+foreign import javascript unsafe "$r = JSON.stringify($1);" jsrefToJSON :: JSRef a -> JSStringRef+#elif defined(USE_WEBKIT)+valToJSON indent val = do+ gctxt <- ask+ rval <- makeValueRef val+ rethrow $ liftIO . jsvaluecreatejsonstring gctxt rval (fromIntegral indent)+#else+valToJSON = undefined+#endif++-- | Given a JavaScript value get its object value.+-- May throw JSException.+--+-- >>> testJSC $ (valToObject JSNull >>= valToText) `catch` \ (JSException e) -> valToText e+-- TypeError: 'null' is not an object+-- >>> testJSC $ (valToObject () >>= valToText) `catch` \ (JSException e) -> valToText e+-- TypeError: 'undefined' is not an object+-- >>> testJSC $ valToObject True+-- true+-- >>> testJSC $ valToObject False+-- false+-- >>> testJSC $ valToObject (1.0 :: Double)+-- 1+-- >>> testJSC $ valToObject (0.0 :: Double)+-- 0+-- >>> testJSC $ valToObject ""+--+-- >>> testJSC $ valToObject "1"+-- 1+valToObject :: MakeValueRef val => val -> JSC JSObjectRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+valToObject val = castRef <$> makeValueRef val+#else+valToObject val = do+ gctxt <- ask+ rval <- makeValueRef val+ rethrow $ liftIO . jsvaluetoobject gctxt rval+#endif++-- | Convert to a JavaScript value (just an alias for 'makeValueRef')+val :: MakeValueRef value+ => value -- ^ value to convert to a JavaScript value+ -> JSC JSValueRef+val = makeValueRef++-- | If we already have a JSValueRef we are fine+instance MakeValueRef JSValueRef where+ makeValueRef = return++-- | A single JSValueRef can be used as the argument list+instance MakeArgRefs JSValueRef where+ makeArgRefs arg = return [arg]++-- | JSValueRef can be made by evaluating a function in 'JSC' as long+-- as it returns something we can make into a JSValueRef.+instance MakeValueRef v => MakeValueRef (JSC v) where+ makeValueRef v = v >>= makeValueRef++----------- null ---------------+-- | Make a @null@ JavaScript value+valMakeNull :: JSC JSValueRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+valMakeNull = return jsNull+#else+valMakeNull = ask >>= (liftIO . jsvaluemakenull)+#endif++-- | Makes a @null@ JavaScript value+instance MakeValueRef JSNull where+ makeValueRef = const valMakeNull++-- | Makes an argument list with just a single @null@ JavaScript value+instance MakeArgRefs JSNull where+ makeArgRefs _ = valMakeNull >>= (\ref -> return [ref])++----------- undefined ---------------+-- | Make an @undefined@ JavaScript value+valMakeUndefined :: JSC JSValueRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+valMakeUndefined = return jsUndefined+#else+valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)+#endif++-- | Makes an @undefined@ JavaScript value+instance MakeValueRef JSUndefined where+ makeValueRef = const valMakeUndefined++--We can't allow this if JSUndefined is () as () is no args not "(null)".+--Use [()] instead.+--instance MakeArgRefs JSUndefined where+-- makeArgRefs _ = valMakeUndefined >>= (\ref -> return [ref])++-- | This allows us to pass no arguments easily (altenative would be to use @[]::[JSValueRef]@).+instance MakeArgRefs () where+ makeArgRefs _ = return []++----------- booleans ---------------+-- | Make a JavaScript boolean value+valMakeBool :: JSBool -> JSC JSValueRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+valMakeBool b = return . castRef $ toJSBool b+#else+valMakeBool b = do+ gctxt <- ask+ liftIO $ jsvaluemakeboolean gctxt b+#endif++-- | Make a JavaScript boolean value+instance MakeValueRef Bool where+ makeValueRef = valMakeBool++-- | Makes an argument list with just a single JavaScript boolean value+instance MakeArgRefs Bool where+ makeArgRefs b = valMakeBool b >>= (\ref -> return [ref])++----------- numbers ---------------+-- | Make a JavaScript number+valMakeNumber :: JSNumber -> JSC JSValueRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+valMakeNumber n = liftIO $ castRef <$> toJSRef n+#else+valMakeNumber n = do+ gctxt <- ask+ liftIO $ jsvaluemakenumber gctxt n+#endif++-- | Makes a JavaScript number+instance MakeValueRef Double where+ makeValueRef = valMakeNumber++-- | Makes an argument list with just a single JavaScript number+instance MakeArgRefs Double where+ makeArgRefs n = valMakeNumber n >>= (\ref -> return [ref])++----------- numbers ---------------+-- | Make a JavaScript string+valMakeString :: Text -> JSC JSValueRef+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)+valMakeString = return . castRef . toJSString+#else+valMakeString text = do+ gctxt <- ask+ liftIO $ jsvaluemakestring gctxt (textToStr text)+#endif++-- | Makes a JavaScript string+instance MakeValueRef Text where+ makeValueRef = valMakeString++-- | Makes an argument list with just a single JavaScript string+instance MakeArgRefs Text where+ makeArgRefs t = valMakeString t >>= (\ref -> return [ref])++-- | Makes a JavaScript string+instance MakeValueRef String where+ makeValueRef = valMakeString . T.pack++-- | Derefernce a value reference.+--+-- >>> testJSC $ show <$> deRefVal JSNull+-- ValNull+-- >>> testJSC $ show <$> deRefVal ()+-- ValUndefined+-- >>> testJSC $ show <$> deRefVal True+-- ValBool True+-- >>> testJSC $ show <$> deRefVal False+-- ValBool False+-- >>> testJSC $ show <$> deRefVal (1.0 :: Double)+-- ValNumber 1.0+-- >>> testJSC $ show <$> deRefVal (0.0 :: Double)+-- ValNumber 0.0+-- >>> testJSC $ show <$> deRefVal ""+-- ValString ""+-- >>> testJSC $ show <$> deRefVal "1"+-- ValString "1"+-- >>> testJSC $ show <$> valToObject True >>= deRefVal+-- ValObject 0x...+deRefVal :: MakeValueRef val => val -> JSC JSValue+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)+deRefVal val = do+ gctxt <- ask+ valref <- makeValueRef val+ case (jsrefGetType valref :: Int) of+ 0 -> return ValUndefined+ 1 -> return ValNull+ 2 -> ValBool <$> valToBool valref+ 3 -> ValNumber <$> valToNumber valref+ 4 -> ValString <$> (valToStr valref >>= strToText)+ 5 -> ValObject <$> valToObject valref+foreign import javascript unsafe "$r = ($1 === undefined)?0:\+ ($1===null)?1:\+ (typeof $1===\"boolean\")?2:\+ (typeof $1===\"number\")?3:\+ (typeof $1===\"string\")?4:\+ (typeof $1===\"object\")?5:-1;" jsrefGetType :: JSValueRef -> Int+#elif defined(USE_WEBKIT)+deRefVal val = do+ gctxt <- ask+ valref <- makeValueRef val+ t <- liftIO $ jsvaluegettype gctxt valref+ case t of+ Kjstypenull -> return ValNull+ Kjstypeundefined -> return ValUndefined+ Kjstypeboolean -> ValBool <$> valToBool valref+ Kjstypenumber -> ValNumber <$> valToNumber valref+ Kjstypestring -> ValString <$> (valToStr valref >>= strToText)+ Kjstypeobject -> ValObject <$> valToObject valref+#else+deRefVal = undefined+#endif++-- | Make a JavaScript value out of a 'JSValue' ADT.+--+-- >>> testJSC $ valMakeRef ValNull+-- "null"+-- >>> testJSC $ valMakeRef ValUndefined+-- "undefined"+-- >>> testJSC $ valMakeRef (ValBool True)+-- "true"+-- >>> testJSC $ valMakeRef (ValNumber 1)+-- "1"+-- >>> testJSC $ valMakeRef (ValString $ pack "Hello")+-- "Hello"+valMakeRef :: JSValue -> JSC JSValueRef+valMakeRef val =+ case val of+ ValNull -> valMakeNull+ ValUndefined -> valMakeUndefined+ ValBool b -> valMakeBool b+ ValNumber n -> valMakeNumber n+ ValString s -> valMakeString s+ ValObject o -> return o++-- | Makes a JavaScript value from a 'JSValue' ADT.+instance MakeValueRef JSValue where+ makeValueRef = valMakeRef++-- | Makes an argument list with just a single JavaScript value from a 'JSValue' ADT.+instance MakeArgRefs JSValue where+ makeArgRefs v = valMakeRef v >>= (\ref -> return [ref])++instance MakeObjectRef JSNull where+ makeObjectRef = const valMakeNull+
+ tests/TestJSC.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE RecordWildCards #-}+-----------------------------------------------------------------------------+--+-- Module : TestJSC+-- Copyright : (c) Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- |+--+-----------------------------------------------------------------------------++module Main (+ main+) where++import Prelude hiding((!!), catch)+import Graphics.UI.Gtk+ (Window, widgetDestroy, postGUIAsync, postGUISync, widgetShowAll,+ mainGUI, mainQuit, on, objectDestroy, containerAdd, scrolledWindowNew,+ windowSetPosition, windowSetDefaultSize, timeoutAddFull, windowNew,+ initGUI)+import Control.Concurrent+ (tryTakeMVar, forkIO, newMVar, putMVar, takeMVar, newEmptyMVar,+ yield)+import System.Glib.MainLoop (priorityHigh)+import Graphics.UI.Gtk.General.Enums (WindowPosition(..))+import Graphics.UI.Gtk.WebKit.WebView+ (webViewGetMainFrame, webViewNew)+import System.IO.Unsafe (unsafePerformIO)+import Control.Monad.Trans.Reader (runReaderT)+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase (JSContextRef)+import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame+ (webFrameGetGlobalContext)+import Language.Javascript.JSC+import Data.Text (Text)+import qualified Data.Text as T+import Control.Applicative+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad (forM, when)+import System.Log.Logger (debugM)+import Control.Lens.Getter ((^.))+import Data.Monoid ((<>))++data TestState = TestState { jsContext :: JSContextRef, window :: Window }++state = unsafePerformIO $ newMVar Nothing+done = unsafePerformIO $ newEmptyMVar++-- >>> testJSC $ ((global ^. js "console" . js "log") # ["Hello"])+testJSC :: MakeValueRef val => JSC val -> IO ()+testJSC = testJSC' False++-- >>> showJSC $ eval "document.body.innerHTML = 'Test'"+showJSC :: MakeValueRef val => JSC val -> IO ()+showJSC = testJSC' True++debugLog = debugM "jsc"++testJSC' :: MakeValueRef val => Bool -> JSC val -> IO ()+testJSC' showWindow f = do+ debugLog "taking done"+ tryTakeMVar done+ debugLog "taking state"+ mbState <- takeMVar state+ TestState {..} <- case mbState of+ Nothing -> do+ debugLog "newState"+ newState <- newEmptyMVar+ debugLog "fork"+ forkIO $ do+ debugLog "initGUI"+ initGUI+ debugLog "windowNew"+ window <- windowNew+ debugLog "timeoutAdd"+ timeoutAddFull (yield >> return True) priorityHigh 10+ windowSetDefaultSize window 900 600+ windowSetPosition window WinPosCenter+ scrollWin <- scrolledWindowNew Nothing Nothing+ webView <- webViewNew+ window `containerAdd` scrollWin+ scrollWin `containerAdd` webView+ on window objectDestroy $ do+ debugLog "onDestroy"+ tryTakeMVar state+ debugLog "put state"+ putMVar state Nothing+ debugLog "mainQuit"+ mainQuit+ debugLog "put done"+ putMVar done ()+ return True+ debugLog "get context"+ jsContext <- webViewGetMainFrame webView >>= webFrameGetGlobalContext+ debugLog "put initial state"+ putMVar newState TestState {..}+ debugLog "maybe show"+ when showWindow $ widgetShowAll window+ debugLog "mainGUI"+ mainGUI+ debugLog "mainGUI exited"+ takeMVar newState+ Just s@TestState {..} -> do+ debugLog "maybe show (2)"+ when showWindow . postGUISync $ widgetShowAll window+ return s+ x <- postGUISync $ runReaderT ((f >>= valToText >>= liftIO . putStrLn . T.unpack)+ `catch` \ (JSException e) -> valToText e >>= liftIO . putStrLn . T.unpack) jsContext+ debugLog "put state"+ putMVar state $ Just TestState {..}+ return x++main = do+ testJSC $ return ()+ Just TestState{..} <- takeMVar state+ postGUIAsync $ widgetDestroy window+ takeMVar done++listWindowProperties = testJSC $ T.pack . show <$> do+ window <- jsg "window"+ names <- propertyNames window+ forM names $ \name -> do+ v <- window ^. js name >>= valToText+ n <- strToText name+ return (n, v)+ `catch`+ \(JSException e) -> do+ n <- strToText name+ msg <- valToText e+ return (n, (T.pack $ " error ") <> msg)+++++++++