git.iko.soy/jsaddle
on master help sign in
Improve EDSL
aadf360Hamish Mackenzie
src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSC.hs−4
compare with master
unifiedsplit
@@ -19,7 +19,6 @@ module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC (
19 , module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
19 , module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
20 , module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Object
20 , module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Object
21
21
22− , global
23 , evaluateScript
22 , evaluateScript
24 , eval
23 , eval
25) where
24) where
@@ -36,9 +35,6 @@ import Foreign (nullPtr)
36import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
35import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
37 (jsevaluatescript, JSValueRefRef)
36 (jsevaluatescript, JSValueRefRef)
38
37
39−global :: JSC JSObjectRef
40−global = ask >>= (liftIO . jscontextgetglobalobject)
41−
42evaluateScript :: MakeStringRef script
38evaluateScript :: MakeStringRef script
43 => MakeStringRef url
39 => MakeStringRef url
44 => script
40 => script
src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSC/Object.hs+139−24
@@ -20,23 +20,26 @@ module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Object (
20 , objGetProperty
20 , objGetProperty
21 , objCallAsFunction
21 , objCallAsFunction
22 , (!)
22 , (!)
23− , (.!)
24 , (#)
23 , (#)
25 , (<#)
24 , (<#)
25+ , new
26 , function
26 , function
27 , fun
27 , fun
28+ , array
29+ , global
28) where
30) where
29
31
30import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
32import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
31 (JSStringRef, JSObjectRef, JSValueRefRef, JSValueRef, JSContextRef)
33 (JSStringRef, JSObjectRef, JSValueRefRef, JSValueRef, JSContextRef)
32import Foreign.C (CULong(..))
34import Foreign.C (CULong(..))
33import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
35import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
36+ (jsobjectcallasconstructor, jsobjectmakearray,
34− (jsobjectcallasfunction, jsobjectgetproperty, jsobjectsetproperty,
37+ jsobjectcallasfunction, jsobjectgetproperty, jsobjectsetproperty,
35 JSPropertyAttributes, JSObjectCallAsFunctionCallback,
38 JSPropertyAttributes, JSObjectCallAsFunctionCallback,
36 jsobjectmakefunctionwithcallback)
39 jsobjectmakefunctionwithcallback)
37import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
40import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value
38 (valMakeUndefined, valToObject, MakeValueRef(..),
41 (valMakeUndefined, valToObject, MakeValueRef(..),
39− MakeStringRef(..))
42+ MakeStringRef(..), MakeArgRefs(..))
40import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad
43import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Monad
41 (rethrow, JSC)
44 (rethrow, JSC)
42import Control.Monad.Trans.Reader (runReaderT, ask)
45import Control.Monad.Trans.Reader (runReaderT, ask)
@@ -48,6 +51,60 @@ import qualified Data.Text as T (pack)
48import Foreign.Storable (Storable(..))
51import Foreign.Storable (Storable(..))
49import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
52import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
50 (jsvaluemakeundefined)
53 (jsvaluemakeundefined)
54+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef
55+ (jscontextgetglobalobject)
56+
57+---- Object Referene ----
58+class MakeObjectRef this where
59+ makeObjectRef :: this -> JSC JSObjectRef
60+
61+instance MakeObjectRef JSObjectRef where
62+ makeObjectRef = return
63+
64+instance MakeObjectRef v => MakeObjectRef (JSC v) where
65+ makeObjectRef v = v >>= makeObjectRef
66+
67+---- Property References ----
68+data JSPropRef = JSPropRef JSObjectRef JSStringRef
69+
70+class MakePropRef this where
71+ makePropRef :: this -> JSC JSPropRef
72+
73+instance MakePropRef JSPropRef where
74+ makePropRef (JSPropRef this name) = do
75+ rthis <- makeObjectRef this
76+ rname <- makeStringRef name
77+ return (JSPropRef rthis rname)
78+
79+instance MakePropRef prop => MakePropRef (JSC prop) where
80+ makePropRef prop = prop >>= makePropRef
81+
82+instance MakeObjectRef JSPropRef where
83+ makeObjectRef (JSPropRef this name) = rethrow $ objGetProperty this name
84+
85+instance MakeValueRef JSPropRef where
86+ makeValueRef (JSPropRef this name) = rethrow $ objGetProperty this name
87+
88+instance MakeArgRefs JSPropRef where
89+ makeArgRefs (JSPropRef this name) = do
90+ rarg <- rethrow $ objGetProperty this name
91+ return [rarg]
92+
93+---- String global scope ----
94+instance MakePropRef String where
95+ makePropRef name = do
96+ this <- global
97+ rname <- makeStringRef name
98+ return (JSPropRef this rname)
99+
100+instance MakeObjectRef String where
101+ makeObjectRef name = do
102+ this <- global
103+ rname <- makeStringRef name
104+ (rethrow $ objGetProperty this rname) >>= valToObject
105+
106+global :: JSC JSObjectRef
107+global = ask >>= (liftIO . jscontextgetglobalobject)
51
108
52objSetProperty :: (MakeStringRef name, MakeValueRef val)
109objSetProperty :: (MakeStringRef name, MakeValueRef val)
53 => JSObjectRef
110 => JSObjectRef
@@ -72,34 +129,54 @@ objGetProperty this name exceptions = do
72 sName <- makeStringRef name
129 sName <- makeStringRef name
73 liftIO $ jsobjectgetproperty gctxt this sName exceptions
130 liftIO $ jsobjectgetproperty gctxt this sName exceptions
74
131
75−objCallAsFunction :: MakeValueRef arg
132+objCallAsFunction :: MakeArgRefs args
76 => JSObjectRef
133 => JSObjectRef
77 -> JSObjectRef
134 -> JSObjectRef
78− -> [arg]
135+ -> args
79 -> JSValueRefRef
136 -> JSValueRefRef
80 -> JSC JSValueRef
137 -> JSC JSValueRef
81objCallAsFunction function this args exceptions = do
138objCallAsFunction function this args exceptions = do
82 gctxt <- ask
139 gctxt <- ask
83− rargs <- mapM makeValueRef args
140+ rargs <- makeArgRefs args
84 liftIO $ withArrayLen rargs $ \ largs pargs ->
141 liftIO $ withArrayLen rargs $ \ largs pargs ->
85 jsobjectcallasfunction gctxt function this (fromIntegral largs) pargs exceptions
142 jsobjectcallasfunction gctxt function this (fromIntegral largs) pargs exceptions
86
143
87−this ! name = return (this, name)
144+objCallAsConstructor :: MakeArgRefs args
88−
145+ => JSObjectRef
89−exp .! name2 = do
146+ -> args
90− (this1, name1) <- exp
147+ -> JSValueRefRef
91− this2 <- (rethrow $ objGetProperty this1 name1) >>= valToObject
148+ -> JSC JSValueRef
92− this2 ! name2
149+objCallAsConstructor function args exceptions = do
93−
150+ gctxt <- ask
151+ rargs <- makeArgRefs args
152+ liftIO $ withArrayLen rargs $ \ largs pargs ->
153+ jsobjectcallasconstructor gctxt function (fromIntegral largs) pargs exceptions
154+
155+(!) :: (MakeObjectRef this, MakeStringRef name) => this -> name -> JSC JSPropRef
156+this ! name = do
157+ rthis <- makeObjectRef this
158+ rname <- makeStringRef name
159+ return (JSPropRef rthis rname)
160+
161+(#) :: (MakePropRef prop, MakeArgRefs args)
162+ => prop -> args -> JSC JSValueRef
94−exp # args = do
163+prop # args = do
95− (this, name) <- exp
164+ (JSPropRef this name) <- makePropRef prop
96 f <- (rethrow $ objGetProperty this name) >>= valToObject
165 f <- (rethrow $ objGetProperty this name) >>= valToObject
97 rethrow $ objCallAsFunction f this args
166 rethrow $ objCallAsFunction f this args
98
167
168+(<#) :: (MakePropRef prop, MakeValueRef val)
169+ => prop -> val -> JSC ()
99−exp <# val = do
170+prop <# val = do
100− (this, name) <- exp
171+ (JSPropRef this name) <- makePropRef prop
101 rethrow $ objSetProperty this name val 0
172 rethrow $ objSetProperty this name val 0
102
173
174+new :: (MakeObjectRef constructor, MakeArgRefs args)
175+ => constructor -> args -> JSC JSValueRef
176+new constructor args = do
177+ f <- makeObjectRef constructor
178+ rethrow $ objCallAsConstructor f args
179+
103type JSObjectCallAsFunctionCallback' =
180type JSObjectCallAsFunctionCallback' =
104 JSContextRef
181 JSContextRef
105 -> JSValueRef
182 -> JSValueRef
@@ -109,12 +186,14 @@ type JSObjectCallAsFunctionCallback' =
109 -> JSValueRefRef
186 -> JSValueRefRef
110 -> IO JSValueRef
187 -> IO JSValueRef
111
188
189+type JSCallAsFunction = JSValueRef -> JSValueRef -> [JSValueRef] -> JSC ()
190+
112foreign import ccall "wrapper"
191foreign import ccall "wrapper"
113 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback
192 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback
114
193
115−function :: (MakeStringRef name, MakeValueRef result)
194+function :: MakeStringRef name
116 => name
195 => name
117− -> (JSValueRef -> JSValueRef -> [JSValueRef] -> JSC result)
196+ -> JSCallAsFunction
118 -> JSC JSObjectRef
197 -> JSC JSObjectRef
119function name f = do
198function name f = do
120 gctxt <- ask
199 gctxt <- ask
@@ -127,14 +206,50 @@ function name f = do
127 flip runReaderT ctx $ do
206 flip runReaderT ctx $ do
128 f fobj this args >>= makeValueRef
207 f fobj this args >>= makeValueRef
129 `E.catch` \(e :: SomeException) -> do
208 `E.catch` \(e :: SomeException) -> do
130− str <- runReaderT (makeValueRef $ show e) ctx
209+ str <- runReaderT (makeValueRef . T.pack $ show e) ctx
131 poke exception str
210 poke exception str
132 jsvaluemakeundefined ctx
211 jsvaluemakeundefined ctx
133
212
134−data JSCallAsFunction result = JSCallAsFunction (JSValueRef -> JSValueRef -> [JSValueRef] -> JSC result)
213+fun :: JSCallAsFunction -> JSCallAsFunction
214+fun f = f
215+
216+instance MakeValueRef JSCallAsFunction where
217+ makeValueRef f = function (nullPtr::JSStringRef) f
218+
219+instance MakeArgRefs JSCallAsFunction where
220+ makeArgRefs f = do
221+ rarg <- function (nullPtr::JSStringRef) f
222+ return [rarg]
223+
224+makeArray :: MakeArgRefs args => args -> JSValueRefRef -> JSC JSObjectRef
225+makeArray args exceptions = do
226+ gctxt <- ask
227+ rargs <- makeArgRefs args
228+ liftIO $ withArrayLen rargs $ \ len ptr ->
229+ jsobjectmakearray gctxt (fromIntegral len) ptr exceptions
230+
231+array :: MakeArgRefs args => args -> JSC JSValueRef
232+array = rethrow . makeArray
233+
234+
235+
236+
237+
238+
239+
240+
241+
242+
243+
244+
245+
246+
247+
248+
249+
250+
251+
252+
135
253
136−fun = JSCallAsFunction
137
254
138−instance MakeValueRef result => MakeValueRef (JSCallAsFunction result) where
139− makeValueRef (JSCallAsFunction f) = function (nullPtr::JSStringRef) f
140
255
src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSC/Value.hs+81−2
@@ -34,9 +34,13 @@ module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSC.Value (
34 , strToText
34 , strToText
35 , textToStr
35 , textToStr
36
36
37+ , valToText
38+
37 , MakeValueRef(..)
39 , MakeValueRef(..)
38 , MakeStringRef(..)
40 , MakeStringRef(..)
41+ , MakeArgRefs(..)
39
42
43+ , val
40 , valMakeNull
44 , valMakeNull
41 , valMakeUndefined
45 , valMakeUndefined
42 , valMakeBool
46 , valMakeBool
@@ -111,14 +115,69 @@ textToStr text = do
111 liftIO $ useAsPtr text $ \p l -> do
115 liftIO $ useAsPtr text $ \p l -> do
112 jsstringcreatewithcharacters (castPtr p) (fromIntegral l)
116 jsstringcreatewithcharacters (castPtr p) (fromIntegral l)
113
117
118+valToText :: JSValueRef -> JSC Text
119+valToText jsvar = valToStr jsvar >>= strToText
120+
114class MakeValueRef a where
121class MakeValueRef a where
115 makeValueRef :: a -> JSC JSValueRef
122 makeValueRef :: a -> JSC JSValueRef
116
123
124+class MakeStringRef a where
125+ makeStringRef :: MonadIO m => a -> m JSStringRef
126+
127+---- Arguments ----
128+class MakeArgRefs this where
129+ makeArgRefs :: this -> JSC [JSValueRef]
130+
131+instance MakeArgRefs arg => MakeArgRefs (JSC arg) where
132+ makeArgRefs arg = arg >>= makeArgRefs
133+
134+instance MakeValueRef arg => MakeArgRefs [arg] where
135+ makeArgRefs = mapM makeValueRef
136+
137+instance MakeArgRefs () where
138+ makeArgRefs _ = return []
139+
140+instance (MakeValueRef arg1, MakeValueRef arg2) => MakeArgRefs (arg1, arg2) where
141+ makeArgRefs (arg1, arg2) = do
142+ rarg1 <- makeValueRef arg1
143+ rarg2 <- makeValueRef arg2
144+ return [rarg1, rarg2]
145+
146+instance (MakeValueRef arg1, MakeValueRef arg2, MakeValueRef arg3) => MakeArgRefs (arg1, arg2, arg3) where
147+ makeArgRefs (arg1, arg2, arg3) = do
148+ rarg1 <- makeValueRef arg1
149+ rarg2 <- makeValueRef arg2
150+ rarg3 <- makeValueRef arg3
151+ return [rarg1, rarg2, rarg3]
152+
153+instance (MakeValueRef arg1, MakeValueRef arg2, MakeValueRef arg3, MakeValueRef arg4) => MakeArgRefs (arg1, arg2, arg3, arg4) where
154+ makeArgRefs (arg1, arg2, arg3, arg4) = do
155+ rarg1 <- makeValueRef arg1
156+ rarg2 <- makeValueRef arg2
157+ rarg3 <- makeValueRef arg3
158+ rarg4 <- makeValueRef arg4
159+ return [rarg1, rarg2, rarg3, rarg3]
160+
161+instance (MakeValueRef arg1, MakeValueRef arg2, MakeValueRef arg3, MakeValueRef arg4, MakeValueRef arg5) => MakeArgRefs (arg1, arg2, arg3, arg4, arg5) where
162+ makeArgRefs (arg1, arg2, arg3, arg4, arg5) = do
163+ rarg1 <- makeValueRef arg1
164+ rarg2 <- makeValueRef arg2
165+ rarg3 <- makeValueRef arg3
166+ rarg4 <- makeValueRef arg4
167+ rarg5 <- makeValueRef arg5
168+ return [rarg1, rarg2, rarg3, rarg3, rarg5]
169+
170+val :: MakeValueRef v => v -> JSC JSValueRef
171+val = makeValueRef
172+
117instance MakeValueRef JSValueRef where
173instance MakeValueRef JSValueRef where
118 makeValueRef = return
174 makeValueRef = return
119
175
120−class MakeStringRef a where
176+instance MakeArgRefs JSValueRef where
121− makeStringRef :: MonadIO m => a -> m JSStringRef
177+ makeArgRefs arg = return [arg]
178+
179+instance MakeValueRef v => MakeValueRef (JSC v) where
180+ makeValueRef prop = prop >>= makeValueRef
122
181
123instance MakeStringRef JSStringRef where
182instance MakeStringRef JSStringRef where
124 makeStringRef = return
183 makeStringRef = return
@@ -135,12 +194,19 @@ valMakeNull = ask >>= (liftIO . jsvaluemakenull)
135instance MakeValueRef JSNull where
194instance MakeValueRef JSNull where
136 makeValueRef = const valMakeNull
195 makeValueRef = const valMakeNull
137
196
197+instance MakeArgRefs JSNull where
198+ makeArgRefs _ = valMakeNull >>= (\ref -> return [ref])
199+
138valMakeUndefined :: JSC JSValueRef
200valMakeUndefined :: JSC JSValueRef
139valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)
201valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)
140
202
141instance MakeValueRef JSUndefined where
203instance MakeValueRef JSUndefined where
142 makeValueRef = const valMakeUndefined
204 makeValueRef = const valMakeUndefined
143
205
206+--We can't allow this if JSUndefined is () as () is now args not "(null)"
207+--instance MakeArgRefs JSUndefined where
208+-- makeArgRefs _ = valMakeUndefined >>= (\ref -> return [ref])
209+
144valMakeBool :: JSBool -> JSC JSValueRef
210valMakeBool :: JSBool -> JSC JSValueRef
145valMakeBool b = do
211valMakeBool b = do
146 gctxt <- ask
212 gctxt <- ask
@@ -149,6 +215,9 @@ valMakeBool b = do
149instance MakeValueRef Bool where
215instance MakeValueRef Bool where
150 makeValueRef = valMakeBool
216 makeValueRef = valMakeBool
151
217
218+instance MakeArgRefs Bool where
219+ makeArgRefs b = valMakeBool b >>= (\ref -> return [ref])
220+
152valMakeNumber :: JSNumber -> JSC JSValueRef
221valMakeNumber :: JSNumber -> JSC JSValueRef
153valMakeNumber n = do
222valMakeNumber n = do
154 gctxt <- ask
223 gctxt <- ask
@@ -157,6 +226,9 @@ valMakeNumber n = do
157instance MakeValueRef Double where
226instance MakeValueRef Double where
158 makeValueRef = valMakeNumber
227 makeValueRef = valMakeNumber
159
228
229+instance MakeArgRefs Double where
230+ makeArgRefs n = valMakeNumber n >>= (\ref -> return [ref])
231+
160valMakeString :: Text -> JSC JSValueRef
232valMakeString :: Text -> JSC JSValueRef
161valMakeString text = do
233valMakeString text = do
162 gctxt <- ask
234 gctxt <- ask
@@ -166,6 +238,9 @@ valMakeString text = do
166instance MakeValueRef Text where
238instance MakeValueRef Text where
167 makeValueRef = valMakeString
239 makeValueRef = valMakeString
168
240
241+instance MakeArgRefs Text where
242+ makeArgRefs t = valMakeString t >>= (\ref -> return [ref])
243+
169instance MakeValueRef String where
244instance MakeValueRef String where
170 makeValueRef = valMakeString . T.pack
245 makeValueRef = valMakeString . T.pack
171
246
@@ -193,3 +268,7 @@ valMakeRef val = do
193
268
194instance MakeValueRef JSValue where
269instance MakeValueRef JSValue where
195 makeValueRef = valMakeRef
270 makeValueRef = valMakeRef
271+
272+instance MakeArgRefs JSValue where
273+ makeArgRefs v = valMakeRef v >>= (\ref -> return [ref])
274+