git.iko.soy/jsaddle
on master help sign in
Initial version
e294f1aHamish Mackenzie
LICENSEnew file+21
compare with master
unifiedsplit
@@ -0,0 +1,21 @@
1+Copyright (c) 2010-2012 Hamish Mackenzie, Victor Nazarov, Luite Stegeman
2+
3+Permission is hereby granted, free of charge, to any person obtaining
4+a copy of this software and associated documentation files (the
5+"Software"), to deal in the Software without restriction, including
6+without limitation the rights to use, copy, modify, merge, publish,
7+distribute, sublicense, and/or sell copies of the Software, and to
8+permit persons to whom the Software is furnished to do so, subject to
9+the following conditions:
10+
11+The above copyright notice and this permission notice shall be
12+included in all copies or substantial portions of the Software.
13+
14+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
17+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
18+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
19+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
20+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21+
Setup.lhsnew file+6
@@ -0,0 +1,6 @@
1+#!/usr/bin/runhaskell
2+> module Main where
3+> import Distribution.Simple
4+> main :: IO ()
5+> main = defaultMain
6+
jsc.cabalnew file+21
@@ -0,0 +1,21 @@
1+Name: jsc
2+Version: 0.0.1
3+Synopsis: High level interface for webkit-javascriptcore
4+Description: High level interface for JavaScriptCore module from webkitgtk
5+License: MIT
6+License-file: LICENSE
7+Author: Hamish Mackenzie
8+Maintainer: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
9+Build-Type: Custom
10+Cabal-Version: >= 1.8
11+
12+Library
13+ hs-source-dirs: src
14+ build-depends: base -any, text >=0.11.2.3 && <0.12,
15+ transformers >=0.3.0.0 && <0.4,
16+ webkit-javascriptcore >=0.0.0.999 && <0.1
17+ exposed-modules:
18+ Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Object
19+ Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC
20+ Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
21+ Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad
src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSC.hsnew file+59
@@ -0,0 +1,59 @@
1+{-# LANGUAGE ForeignFunctionInterface
2+ , TypeSynonymInstances
3+ , FlexibleInstances
4+ , DeriveDataTypeable #-}
5+-----------------------------------------------------------------------------
6+--
7+-- Module : Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC
8+-- Copyright : (c) Hamish Mackenzie
9+-- License : MIT
10+--
11+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
12+--
13+-- |
14+--
15+-----------------------------------------------------------------------------
16+
17+module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC (
18+ module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad
19+ , module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
20+ , module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Object
21+
22+ , global
23+ , evaluateScript
24+ , eval
25+) where
26+
27+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad
28+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
29+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Object
30+
31+import Control.Monad.Trans.Reader (ask)
32+import Control.Monad.IO.Class (MonadIO(..))
33+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef
34+ (jscontextgetglobalobject)
35+import Foreign (nullPtr)
36+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
37+ (jsevaluatescript, JSValueRefRef)
38+
39+global :: JSC JSObjectRef
40+global = ask >>= (liftIO . jscontextgetglobalobject)
41+
42+evaluateScript :: MakeStringRef script
43+ => MakeStringRef url
44+ => script
45+ -> JSObjectRef
46+ -> url
47+ -> Int
48+ -> JSValueRefRef
49+ -> JSC JSValueRef
50+evaluateScript script this url line exception = do
51+ gctxt <- ask
52+ sScript <- makeStringRef script
53+ sUrl <- makeStringRef url
54+ liftIO $ jsevaluatescript gctxt sScript this sUrl line exception
55+
56+eval script = rethrow $ evaluateScript script nullPtr (nullPtr::JSStringRef) 1
57+
58+
59+
src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSC/Monad.hsnew file+52
@@ -0,0 +1,52 @@
1+{-# LANGUAGE ForeignFunctionInterface
2+ , TypeSynonymInstances
3+ , FlexibleInstances
4+ , DeriveDataTypeable #-}
5+-----------------------------------------------------------------------------
6+--
7+-- Module : Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad
8+-- Copyright : (c) Hamish Mackenzie
9+-- License : MIT
10+--
11+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
12+--
13+-- |
14+--
15+-----------------------------------------------------------------------------
16+
17+module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad (
18+ JSC(..)
19+ , JSException(..)
20+ , catch
21+ , rethrow
22+) where
23+
24+import qualified Control.Exception as E (throwIO, Exception)
25+import Control.Monad.Trans.Reader (runReaderT, ask, ReaderT(..))
26+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
27+ (JSValueRefRef, JSValueRef, JSContextRef)
28+import Data.Typeable (Typeable)
29+import Control.Monad.IO.Class (MonadIO(..))
30+import Foreign (nullPtr, alloca)
31+import Foreign.Storable (Storable(..))
32+
33+type JSC = ReaderT JSContextRef IO
34+
35+newtype JSException = JSException JSValueRef deriving (Show, Typeable)
36+
37+instance E.Exception JSException
38+
39+catch :: (JSValueRefRef -> JSC a) -> (JSValueRef -> JSC a) -> JSC a
40+catch f catcher = do
41+ gctxt <- ask
42+ liftIO . alloca $ \pexc -> flip runReaderT gctxt $ do
43+ result <- f pexc
44+ exc <- liftIO $ peek pexc
45+ if exc == nullPtr
46+ then return result
47+ else catcher exc
48+
49+rethrow :: (JSValueRefRef -> JSC a) -> JSC a
50+rethrow = flip catch $ liftIO . E.throwIO . JSException
51+
52+
src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSC/Object.hsnew file+140
@@ -0,0 +1,140 @@
1+{-# LANGUAGE ForeignFunctionInterface
2+ , TypeSynonymInstances
3+ , FlexibleInstances
4+ , DeriveDataTypeable
5+ , ScopedTypeVariables #-}
6+-----------------------------------------------------------------------------
7+--
8+-- Module : Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Object
9+-- Copyright : (c) Hamish Mackenzie
10+-- License : MIT
11+--
12+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
13+--
14+-- |
15+--
16+-----------------------------------------------------------------------------
17+
18+module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Object (
19+ objSetProperty
20+ , objGetProperty
21+ , objCallAsFunction
22+ , (!)
23+ , (.!)
24+ , (#)
25+ , (<#)
26+ , function
27+ , fun
28+) where
29+
30+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
31+ (JSStringRef, JSObjectRef, JSValueRefRef, JSValueRef, JSContextRef)
32+import Foreign.C (CULong(..))
33+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
34+ (jsobjectcallasfunction, jsobjectgetproperty, jsobjectsetproperty,
35+ JSPropertyAttributes, JSObjectCallAsFunctionCallback,
36+ jsobjectmakefunctionwithcallback)
37+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
38+ (valMakeUndefined, valToObject, MakeValueRef(..),
39+ MakeStringRef(..))
40+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad
41+ (rethrow, JSC)
42+import Control.Monad.Trans.Reader (runReaderT, ask)
43+import Control.Monad.IO.Class (MonadIO(..))
44+import Foreign (peekArray, nullPtr, withArrayLen)
45+import qualified Control.Exception as E (catch)
46+import Control.Exception (SomeException)
47+import qualified Data.Text as T (pack)
48+import Foreign.Storable (Storable(..))
49+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
50+ (jsvaluemakeundefined)
51+
52+objSetProperty :: (MakeStringRef name, MakeValueRef val)
53+ => JSObjectRef
54+ -> name
55+ -> val
56+ -> JSPropertyAttributes
57+ -> JSValueRefRef
58+ -> JSC ()
59+objSetProperty this name val attributes exceptions = do
60+ gctxt <- ask
61+ sName <- makeStringRef name
62+ vref <- makeValueRef val
63+ liftIO $ jsobjectsetproperty gctxt this sName vref attributes exceptions
64+
65+objGetProperty :: MakeStringRef name
66+ => JSObjectRef
67+ -> name
68+ -> JSValueRefRef
69+ -> JSC JSValueRef
70+objGetProperty this name exceptions = do
71+ gctxt <- ask
72+ sName <- makeStringRef name
73+ liftIO $ jsobjectgetproperty gctxt this sName exceptions
74+
75+objCallAsFunction :: MakeValueRef arg
76+ => JSObjectRef
77+ -> JSObjectRef
78+ -> [arg]
79+ -> JSValueRefRef
80+ -> JSC JSValueRef
81+objCallAsFunction function this args exceptions = do
82+ gctxt <- ask
83+ rargs <- mapM makeValueRef args
84+ liftIO $ withArrayLen rargs $ \ largs pargs ->
85+ jsobjectcallasfunction gctxt function this (fromIntegral largs) pargs exceptions
86+
87+this ! name = return (this, name)
88+
89+exp .! name2 = do
90+ (this1, name1) <- exp
91+ this2 <- (rethrow $ objGetProperty this1 name1) >>= valToObject
92+ this2 ! name2
93+
94+exp # args = do
95+ (this, name) <- exp
96+ f <- (rethrow $ objGetProperty this name) >>= valToObject
97+ rethrow $ objCallAsFunction f this args
98+
99+exp <# val = do
100+ (this, name) <- exp
101+ rethrow $ objSetProperty this name val 0
102+
103+type JSObjectCallAsFunctionCallback' =
104+ JSContextRef
105+ -> JSValueRef
106+ -> JSValueRef
107+ -> CULong
108+ -> JSValueRefRef
109+ -> JSValueRefRef
110+ -> IO JSValueRef
111+
112+foreign import ccall "wrapper"
113+ mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback
114+
115+function :: (MakeStringRef name, MakeValueRef result)
116+ => name
117+ -> (JSValueRef -> JSValueRef -> [JSValueRef] -> JSC result)
118+ -> JSC JSObjectRef
119+function name f = do
120+ gctxt <- ask
121+ callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap
122+ sName <- makeStringRef name
123+ liftIO $ jsobjectmakefunctionwithcallback gctxt sName callback
124+ where
125+ wrap ctx fobj this argc argv exception = do
126+ args <- peekArray (fromIntegral argc) argv
127+ flip runReaderT ctx $ do
128+ f fobj this args >>= makeValueRef
129+ `E.catch` \(e :: SomeException) -> do
130+ str <- runReaderT (makeValueRef $ show e) ctx
131+ poke exception str
132+ jsvaluemakeundefined ctx
133+
134+data JSCallAsFunction result = JSCallAsFunction (JSValueRef -> JSValueRef -> [JSValueRef] -> JSC result)
135+
136+fun = JSCallAsFunction
137+
138+instance MakeValueRef result => MakeValueRef (JSCallAsFunction result) where
139+ makeValueRef (JSCallAsFunction f) = function (nullPtr::JSStringRef) f
140+
src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSC/Value.hsnew file+195
@@ -0,0 +1,195 @@
1+{-# LANGUAGE ForeignFunctionInterface
2+ , TypeSynonymInstances
3+ , FlexibleInstances
4+ , DeriveDataTypeable #-}
5+-----------------------------------------------------------------------------
6+--
7+-- Module : Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
8+-- Copyright : (c) Hamish Mackenzie
9+-- License : MIT
10+--
11+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
12+--
13+-- |
14+--
15+-----------------------------------------------------------------------------
16+
17+module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value (
18+ JSNull(..)
19+ , JSUndefined
20+ , JSBool
21+ , JSNumber
22+ , JSString
23+ , JSValue(..)
24+
25+ , JSStringRef
26+ , JSObjectRef
27+ , JSValueRef
28+
29+ , valToBool
30+ , valToNumber
31+ , valToStr
32+ , valToObject
33+
34+ , strToText
35+ , textToStr
36+
37+ , MakeValueRef(..)
38+ , MakeStringRef(..)
39+
40+ , valMakeNull
41+ , valMakeUndefined
42+ , valMakeBool
43+ , valMakeNumber
44+ , valMakeString
45+
46+ , deRefVal
47+ , valMakeRef
48+) where
49+
50+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
51+ (JSObjectRef, JSStringRef, JSValueRef)
52+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad (rethrow, JSC)
53+import Control.Monad.Trans.Reader (ask)
54+import Control.Monad.IO.Class (MonadIO, MonadIO(..))
55+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
56+ (JSType(..), jsvaluegettype, jsvaluemakestring, jsvaluemakenumber,
57+ jsvaluemakeboolean, jsvaluemakeundefined, jsvaluemakenull,
58+ jsvaluetoobject, jsvaluetostringcopy, jsvaluetonumber,
59+ jsvaluetoboolean)
60+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef
61+ (jsstringcreatewithcharacters, jsstringgetcharactersptr,
62+ jsstringgetlength)
63+import qualified Data.Text.Foreign as T (fromPtr)
64+import Foreign (castPtr)
65+import Data.Text.Foreign (useAsPtr)
66+import Control.Applicative ((<$>))
67+import Data.Text (Text)
68+import qualified Data.Text as T (pack)
69+
70+data JSNull = JSNull
71+type JSUndefined = ()
72+type JSBool = Bool
73+type JSNumber = Double
74+type JSString = Text
75+
76+data JSValue = ValNull
77+ | ValUndefined
78+ | ValBool JSBool
79+ | ValNumber JSNumber
80+ | ValString JSString
81+ | ValObject JSObjectRef deriving(Show)
82+
83+valToBool :: JSValueRef -> JSC JSBool
84+valToBool jsvar = do
85+ gctxt <- ask
86+ liftIO $ jsvaluetoboolean gctxt jsvar
87+
88+valToNumber :: JSValueRef -> JSC JSNumber
89+valToNumber jsvar = do
90+ gctxt <- ask
91+ rethrow $ liftIO . jsvaluetonumber gctxt jsvar
92+
93+valToStr :: JSValueRef -> JSC JSStringRef
94+valToStr jsvar = do
95+ gctxt <- ask
96+ rethrow $ liftIO . jsvaluetostringcopy gctxt jsvar
97+
98+valToObject :: JSValueRef -> JSC JSObjectRef
99+valToObject jsvar = do
100+ gctxt <- ask
101+ rethrow $ liftIO . jsvaluetoobject gctxt jsvar
102+
103+strToText :: MonadIO m => JSStringRef -> m Text
104+strToText jsstring = liftIO $ do
105+ l <- jsstringgetlength jsstring
106+ p <- jsstringgetcharactersptr jsstring
107+ T.fromPtr (castPtr p) (fromIntegral l)
108+
109+textToStr :: MonadIO m => Text -> m JSStringRef
110+textToStr text = do
111+ liftIO $ useAsPtr text $ \p l -> do
112+ jsstringcreatewithcharacters (castPtr p) (fromIntegral l)
113+
114+class MakeValueRef a where
115+ makeValueRef :: a -> JSC JSValueRef
116+
117+instance MakeValueRef JSValueRef where
118+ makeValueRef = return
119+
120+class MakeStringRef a where
121+ makeStringRef :: MonadIO m => a -> m JSStringRef
122+
123+instance MakeStringRef JSStringRef where
124+ makeStringRef = return
125+
126+instance MakeStringRef Text where
127+ makeStringRef = textToStr
128+
129+instance MakeStringRef String where
130+ makeStringRef = textToStr . T.pack
131+
132+valMakeNull :: JSC JSValueRef
133+valMakeNull = ask >>= (liftIO . jsvaluemakenull)
134+
135+instance MakeValueRef JSNull where
136+ makeValueRef = const valMakeNull
137+
138+valMakeUndefined :: JSC JSValueRef
139+valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)
140+
141+instance MakeValueRef JSUndefined where
142+ makeValueRef = const valMakeUndefined
143+
144+valMakeBool :: JSBool -> JSC JSValueRef
145+valMakeBool b = do
146+ gctxt <- ask
147+ liftIO $ jsvaluemakeboolean gctxt b
148+
149+instance MakeValueRef Bool where
150+ makeValueRef = valMakeBool
151+
152+valMakeNumber :: JSNumber -> JSC JSValueRef
153+valMakeNumber n = do
154+ gctxt <- ask
155+ liftIO $ jsvaluemakenumber gctxt n
156+
157+instance MakeValueRef Double where
158+ makeValueRef = valMakeNumber
159+
160+valMakeString :: Text -> JSC JSValueRef
161+valMakeString text = do
162+ gctxt <- ask
163+ s <- textToStr text
164+ liftIO $ jsvaluemakestring gctxt s
165+
166+instance MakeValueRef Text where
167+ makeValueRef = valMakeString
168+
169+instance MakeValueRef String where
170+ makeValueRef = valMakeString . T.pack
171+
172+deRefVal :: JSValueRef -> JSC JSValue
173+deRefVal valref = do
174+ gctxt <- ask
175+ t <- liftIO $ jsvaluegettype gctxt valref
176+ case t of
177+ Kjstypenull -> return ValNull
178+ Kjstypeundefined -> return ValUndefined
179+ Kjstypeboolean -> ValBool <$> valToBool valref
180+ Kjstypenumber -> ValNumber <$> valToNumber valref
181+ Kjstypestring -> ValString <$> (valToStr valref >>= strToText)
182+ Kjstypeobject -> ValObject <$> valToObject valref
183+
184+valMakeRef :: JSValue -> JSC JSValueRef
185+valMakeRef val = do
186+ case val of
187+ ValNull -> valMakeNull
188+ ValUndefined -> valMakeUndefined
189+ ValBool b -> valMakeBool b
190+ ValNumber n -> valMakeNumber n
191+ ValString s -> valMakeString s
192+ ValObject o -> return o
193+
194+instance MakeValueRef JSValue where
195+ makeValueRef = valMakeRef