c974c63 · jsaddle · git.iko.soy

git.iko.soy/jsaddle

Change runjs to testJSC.

Add showJSC (like testJSC but makes the webkit window visible). Use unsafePerformIO to make conversion from Text to JSStringRef pure. Add "js" function to make a getter for a property (for use with the lens package).

commitc974c632f7ba4c72c24e029445fdd0f1d67571e8 authorHamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> dateTue 12 Feb 2013, 00:08 (14 years ago) parent245c81c

8 files changed+174−116

compare with master

unifiedsplit

jsc.cabal+10−9 src/Language/Javascript/JSC/Classes.hs+1−1 src/Language/Javascript/JSC/Evaluate.hs+2−4 src/Language/Javascript/JSC/Object.hs+49−30 src/Language/Javascript/JSC/Properties.hs+2−4 src/Language/Javascript/JSC/String.hs+4−3 src/Language/Javascript/JSC/Value.hs+55−56 tests/TestJSC.hs+51−9

jsc.cabal+10−9

@@ -1,5 +1,5 @@

11name: jsc

2−version: 0.0.1

2+version: 0.1.0.0

33cabal-version: >=1.10

44license: MIT

55license-file: LICENSE

@@ -12,15 +12,15 @@ author: Hamish Mackenzie

1212data-dir: ""

1313

1414library

15− build-depends: template-haskell -any, base -any,

15+ build-depends: template-haskell -any, base -any, lens >=3.8.5 && <3.9,

1616 text >=0.11.2.3 && <0.12, transformers >=0.3.0.0 && <0.4,

1717 webkit-javascriptcore >=0.0.0.999 && <0.1, jmacro >=0.6.3 && <0.7

18− exposed-modules: Language.Javascript.JSC.String

18+ exposed-modules: Language.Javascript.JSC

1919 Language.Javascript.JSC.Arguments Language.Javascript.JSC.Classes

20− Language.Javascript.JSC.Properties Language.Javascript.JSC.JMacro

21− Language.Javascript.JSC.Object Language.Javascript.JSC

22− Language.Javascript.JSC.Value Language.Javascript.JSC.Monad

23− Language.Javascript.JSC.Exception Language.Javascript.JSC.Evaluate

20+ Language.Javascript.JSC.Evaluate Language.Javascript.JSC.Exception

21+ Language.Javascript.JSC.JMacro Language.Javascript.JSC.Monad

22+ Language.Javascript.JSC.Object Language.Javascript.JSC.Properties

23+ Language.Javascript.JSC.String Language.Javascript.JSC.Value

2424 exposed: True

2525 buildable: True

2626 default-language: Haskell2010

@@ -28,10 +28,11 @@ library

2828 other-modules: Language.Javascript.JSC.PropRef

2929

3030test-suite test-tool

31− build-depends: template-haskell -any, base -any,

31+ build-depends: template-haskell -any, base -any, lens >=3.8.5 && <3.9,

3232 text >=0.11.2.3 && <0.12, transformers >=0.3.0.0 && <0.4,

3333 webkit-javascriptcore >=0.0.0.999 && <0.1, jmacro >=0.6.3 && <0.7,

34− webkit -any, gtk -any, glib -any, jsc ==0.0.1

34+ hslogger -any, glib -any, gtk -any, jsc ==0.1.0.0,

35+ webkit -any

3536 type: exitcode-stdio-1.0

3637 main-is: TestJSC.hs

3738 buildable: True

src/Language/Javascript/JSC/Classes.hs+1−1

@@ -33,7 +33,7 @@ class MakeValueRef a where

3333

3434-- | Anything that can be used to make a JavaScript string reference

3535class MakeStringRef a where

36− makeStringRef :: MonadIO m => a -> m JSStringRef

36+ makeStringRef :: a -> JSStringRef

3737

3838-- | Anything that can be used to make a list of JavaScript value

3939-- references for use as function arguments

src/Language/Javascript/JSC/Evaluate.hs+2−4

@@ -33,7 +33,7 @@ import Language.Javascript.JSC.Monad (JSC)

3333-- | Evaluates a script (like eval in java script). Unlike 'eval' this function lets you

3434-- specify a source URL and starting line number for beter error information.

3535--

36−-- >>> runjs $ (evaluateScript "\n\n{" global "FileName" 53 >>= valToText) `catch` \(JSException e) -> array (e,e!"sourceURL", e!"line") >>= valToText

36+-- >>> testJSC $ (evaluateScript "\n\n{" global "FileName" 53 >>= valToText) `catch` \(JSException e) -> array (e,e!"sourceURL", e!"line") >>= valToText

3737-- "SyntaxError: Expected token '}',FileName,55"

3838evaluateScript :: (MakeStringRef script, MakeObjectRef this, MakeStringRef url)

3939 => script -- ^ JavaScript to evaluate

@@ -43,10 +43,8 @@ evaluateScript :: (MakeStringRef script, MakeObjectRef this, MakeStringRef url)

4343 -> JSC JSValueRef

4444evaluateScript script this url line = do

4545 gctxt <- ask

46− sScript <- makeStringRef script

4746 thisr <- makeObjectRef this

48− sUrl <- makeStringRef url

49− rethrow $ liftIO . jsevaluatescript gctxt sScript thisr sUrl line

47+ rethrow $ liftIO . jsevaluatescript gctxt (makeStringRef script) thisr (makeStringRef url) line

5048

5149-- | Evaluates a script (like eval in java script)

5250--

src/Language/Javascript/JSC/Object.hs+49−30

@@ -2,6 +2,8 @@

22{-# LANGUAGE FlexibleInstances #-}

33{-# LANGUAGE TypeSynonymInstances #-}

44{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE NoMonomorphismRestriction #-}

6+{-# LANGUAGE Rank2Types #-}

57-----------------------------------------------------------------------------

68--

79-- Module : Language.Javascript.JSC.Object

@@ -21,6 +23,8 @@ module Language.Javascript.JSC.Object (

2123 -- * Property lookup

2224 , (!)

2325 , (!!)

26+ , js

27+ , jsg

2428

2529 -- * Setting the value of a property

2630 , (<#)

@@ -92,6 +96,9 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

9296import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef

9397 (jscontextgetglobalobject)

9498import Language.Javascript.JSC.Properties

99+import Control.Lens

100+ (IndexPreservingGetter, to, (^.))

101+import Language.Javascript.JSC.String (textToStr)

95102

96103-- | If we already have a JSObjectRef we are fine

97104instance MakeObjectRef JSObjectRef where

@@ -106,8 +113,8 @@ instance MakeObjectRef v => MakeObjectRef (JSC v) where

106113-- the lookup is delayed until we use the JSPropRef. This makes it a bit lazy compared

107114-- to JavaScript's @.@ operator.

108115--

109−-- >>> runjs $ eval "'Hello World'.length"

110−-- >>> runjs $ val "Hello World" ! "length"

116+-- >>> testJSC $ eval "'Hello World'.length"

117+-- >>> testJSC $ val "Hello World" ! "length"

111118-- "11"

112119(!) :: (MakeObjectRef this, MakeStringRef name)

113120 => this -- ^ Object to look on

@@ -115,15 +122,16 @@ instance MakeObjectRef v => MakeObjectRef (JSC v) where

115122 -> JSC JSPropRef -- ^ Property reference

116123this ! name = do

117124 rthis <- makeObjectRef this

118− rname <- makeStringRef name

119125 return (JSPropRef rthis rname)

126+ where

127+ rname = makeStringRef name

120128

121129-- | Lookup a property based on its index. This function just constructs a JSPropRef

122130-- the lookup is delayed until we use the JSPropRef. This makes it a bit lazy compared

123131-- to JavaScript's @[]@ operator.

124132--

125−-- >>> runjs $ eval "'Hello World'[6]"

126−-- >>> runjs $ val "Hello World" !! 6

133+-- >>> testJSC $ eval "'Hello World'[6]"

134+-- >>> testJSC $ val "Hello World" !! 6

127135-- "W"

128136(!!) :: (MakeObjectRef this)

129137 => this -- ^ Object to look on

@@ -133,11 +141,32 @@ this !! index = do

133141 rthis <- makeObjectRef this

134142 return (JSPropIndexRef rthis index)

135143

144+-- | Makes a getter for a particular property name.

145+--

146+-- > js name = to (!name)

147+--

148+-- >>> testJSC $ eval "'Hello World'.length"

149+-- >>> testJSC $ val "Hello World" ^. js "length"

150+-- "11"

151+js :: (MakeObjectRef s, MakeStringRef name)

152+ => name -- ^ Name of the property to find

153+ -> IndexPreservingGetter s (JSC JSPropRef)

154+js name = to (!name)

155+

156+-- | Handy way to get and hold onto a reference top level javascript

157+--

158+-- >>> testJSC $ eval "w = console; w.log('Hello World')"

159+-- >>> testJSC $ do w <- jsg "console"; w ^. js "log" # ["Hello World"]

160+-- "11"

161+jsg :: MakeStringRef a => a -> JSC JSPropRef

162+jsg name = global ! name

163+

136164-- | Call a JavaScript function

137165--

138−-- >>> runjs $ eval "'Hello World'.indexOf('World')"

139−-- >>> runjs $ val "Hello World" ! "indexOf" # ["World"]

166+-- >>> testJSC $ eval "'Hello World'.indexOf('World')"

167+-- >>> testJSC $ val "Hello World" ! "indexOf" # ["World"]

140168-- "6"

169+infixr 2 #

141170(#) :: (MakePropRef prop, MakeArgRefs args)

142171 => prop -> args -> JSC JSValueRef

143172prop # args = do

@@ -147,8 +176,8 @@ prop # args = do

147176

148177-- | Call a JavaScript function

149178--

150−-- >>> runjs $ eval "var j = {}; j.x = 1; j.x"

151−-- >>> runjs $ do {j <- eval "({})"; j!"x" <# 1; j!"x"}

179+-- >>> testJSC $ eval "var j = {}; j.x = 1; j.x"

180+-- >>> testJSC $ do {j <- eval "({})"; j!"x" <# 1; j!"x"}

152181-- "1"

153182infixr 0 <#

154183(<#) :: (MakePropRef prop, MakeValueRef val)

@@ -162,7 +191,7 @@ prop <# val = do

162191

163192-- | Use this to create a new JavaScript object

164193--

165−-- >>> runjs $ new "Date" (2013, 1, 1)

194+-- >>> testJSC $ new "Date" (2013, 1, 1)

166195-- "Fri Feb 01 2013 00:00:00 GMT+1300 (NZDT)"

167196new :: (MakeObjectRef constructor, MakeArgRefs args)

168197 => constructor

@@ -174,8 +203,8 @@ new constructor args = do

174203

175204-- | Call function with a given @this@. In most cases you should use '#'.

176205--

177−-- >>> runjs $ eval "(function(){return this;}).apply('Hello', [])"

178−-- >>> runjs $ do { test <- eval "(function(){return this;})"; call test (val "Hello") () }

206+-- >>> testJSC $ eval "(function(){return this;}).apply('Hello', [])"

207+-- >>> testJSC $ do { test <- eval "(function(){return this;})"; call test (val "Hello") () }

179208-- "Hello"

180209call :: (MakeObjectRef function, MakeObjectRef this, MakeArgRefs args)

181210 => function -> this -> args -> JSC JSValueRef

@@ -206,8 +235,8 @@ type JSCallAsFunction = JSValueRef -- ^ Function object

206235-- | Short hand @::JSCallAsFunction@ so a haskell function can be passed to

207236-- a to a JavaScipt one.

208237--

209−-- >>> runjs $ eval "(function(f) {f('Hello');})(function (a) {console.log(a)})"

210−-- >>> runjs $ call (eval "(function(f) {f('Hello');})") global [fun $ \ _ _ args -> valToText (head args) >>= (liftIO . print) ]

238+-- >>> testJSC $ eval "(function(f) {f('Hello');})(function (a) {console.log(a)})"

239+-- >>> testJSC $ call (eval "(function(f) {f('Hello');})") global [fun $ \ _ _ args -> valToText (head args) >>= (liftIO . print) ]

211240-- "Hello"

212241-- "undefined"

213242fun :: JSCallAsFunction -> JSCallAsFunction

@@ -225,8 +254,7 @@ function :: MakeStringRef name

225254function name f = do

226255 gctxt <- ask

227256 callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap

228− sName <- makeStringRef name

229− liftIO $ jsobjectmakefunctionwithcallback gctxt sName callback

257+ liftIO $ jsobjectmakefunctionwithcallback gctxt (makeStringRef name) callback

230258 where

231259 wrap ctx fobj this argc argv exception = do

232260 args <- peekArray (fromIntegral argc) argv

@@ -257,11 +285,11 @@ makeArray args exceptions = do

257285

258286-- | Make an JavaScript array from a list of values

259287--

260−-- >>> runjs $ eval "['Hello', 'World'][1]"

261−-- >>> runjs $ array ["Hello", "World"] !! 1

288+-- >>> testJSC $ eval "['Hello', 'World'][1]"

289+-- >>> testJSC $ array ["Hello", "World"] !! 1

262290-- "World"

263−-- >>> runjs $ eval "['Hello', null, undefined, true, 1]"

264−-- >>> runjs $ array ("Hello", JSNull, (), True, 1.0::Double)

291+-- >>> testJSC $ eval "['Hello', null, undefined, true, 1]"

292+-- >>> testJSC $ array ("Hello", JSNull, (), True, 1.0::Double)

265293-- "Hello,,,true,1"

266294array :: MakeArgRefs args => args -> JSC JSObjectRef

267295array = rethrow . makeArray

@@ -270,20 +298,11 @@ array = rethrow . makeArray

270298global :: JSC JSObjectRef

271299global = ask >>= (liftIO . jscontextgetglobalobject)

272300

273−---- String global scope ----

274−-- | A string on its own is assumed to be the name of a property in the global object

275−instance MakePropRef String where

276− makePropRef name = do

277− this <- global

278− rname <- makeStringRef name

279− return (JSPropRef this rname)

280−

281301-- | A string on its own is assumed to be the name of a property in the global object

282302instance MakeObjectRef String where

283303 makeObjectRef name = do

284304 this <- global

285− rname <- makeStringRef name

286− rethrow (objGetPropertyByName this rname) >>= valToObject

305+ rethrow (objGetPropertyByName this (makeStringRef name)) >>= valToObject

287306

288307-- | Get an array containing the property names present on a given object

289308copyPropertyNames :: MakeObjectRef this => this -> JSC JSPropertyNameArrayRef

src/Language/Javascript/JSC/Properties.hs+2−4

@@ -82,8 +82,7 @@ objGetPropertyByName :: MakeStringRef name

8282 -> JSC JSValueRef -- ^ returns the property value.

8383objGetPropertyByName this name exceptions = do

8484 gctxt <- ask

85− sName <- makeStringRef name

86− liftIO $ jsobjectgetproperty gctxt this sName exceptions

85+ liftIO $ jsobjectgetproperty gctxt this (makeStringRef name) exceptions

8786

8887-- | Get a property value given the object and the index of the property.

8988objGetPropertyAtIndex :: JSObjectRef -- ^ object to find the property on.

@@ -124,9 +123,8 @@ objSetPropertyByName :: (MakeStringRef name, MakeValueRef val)

124123 -> JSC ()

125124objSetPropertyByName this name val attributes exceptions = do

126125 gctxt <- ask

127− sName <- makeStringRef name

128126 vref <- makeValueRef val

129− liftIO $ jsobjectsetproperty gctxt this sName vref attributes exceptions

127+ liftIO $ jsobjectsetproperty gctxt this (makeStringRef name) vref attributes exceptions

130128

131129-- | Set a property value given the object and the index of the property.

132130objSetPropertyAtIndex :: (MakeValueRef val)

src/Language/Javascript/JSC/String.hs+4−3

@@ -32,10 +32,11 @@ import Foreign (castPtr)

3232import Data.Text.Foreign (useAsPtr)

3333import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase (JSStringRef)

3434import Language.Javascript.JSC.Classes (MakeStringRef(..))

35+import System.IO.Unsafe (unsafePerformIO)

3536

3637-- | If we already have a JSStringRef we are fine

3738instance MakeStringRef JSStringRef where

38− makeStringRef = return

39+ makeStringRef = id

3940

4041instance MakeStringRef Text where

4142 makeStringRef = textToStr

@@ -51,9 +52,9 @@ strToText jsstring = liftIO $ do

5152 T.fromPtr (castPtr p) (fromIntegral l)

5253

5354-- | Convert a Haskell 'Text' to a JavaScript string

54−textToStr :: MonadIO m => Text -> m JSStringRef

55+textToStr :: Text -> JSStringRef

5556textToStr text =

56− liftIO $ useAsPtr text $ \p l ->

57+ unsafePerformIO $ useAsPtr text $ \p l ->

5758 jsstringcreatewithcharacters (castPtr p) (fromIntegral l)

5859

5960

src/Language/Javascript/JSC/Value.hs+55−56

@@ -106,21 +106,21 @@ data JSValue = ValNull -- ^ null

106106-- | Given a JavaScript value get its boolean value.

107107-- All values in JavaScript convert to bool.

108108--

109−-- >>> runjs $ valToBool JSNull

109+-- >>> testJSC $ valToBool JSNull

110110-- False

111−-- >>> runjs $ valToBool ()

111+-- >>> testJSC $ valToBool ()

112112-- False

113−-- >>> runjs $ valToBool True

113+-- >>> testJSC $ valToBool True

114114-- True

115−-- >>> runjs $ valToBool False

115+-- >>> testJSC $ valToBool False

116116-- False

117−-- >>> runjs $ valToBool (1.0 :: Double)

117+-- >>> testJSC $ valToBool (1.0 :: Double)

118118-- True

119−-- >>> runjs $ valToBool (0.0 :: Double)

119+-- >>> testJSC $ valToBool (0.0 :: Double)

120120-- False

121−-- >>> runjs $ valToBool ""

121+-- >>> testJSC $ valToBool ""

122122-- False

123−-- >>> runjs $ valToBool "1"

123+-- >>> testJSC $ valToBool "1"

124124-- True

125125valToBool :: MakeValueRef val => val -> JSC JSBool

126126valToBool val = do

@@ -131,21 +131,21 @@ valToBool val = do

131131-- | Given a JavaScript value get its numeric value.

132132-- May throw JSException.

133133--

134−-- >>> runjs $ valToNumber JSNull

134+-- >>> testJSC $ valToNumber JSNull

135135-- 0.0

136−-- >>> runjs $ valToNumber ()

136+-- >>> testJSC $ valToNumber ()

137137-- NaN

138−-- >>> runjs $ valToNumber True

138+-- >>> testJSC $ valToNumber True

139139-- 1.0

140−-- >>> runjs $ valToNumber False

140+-- >>> testJSC $ valToNumber False

141141-- 0.0

142−-- >>> runjs $ valToNumber (1.0 :: Double)

142+-- >>> testJSC $ valToNumber (1.0 :: Double)

143143-- 0.0

144−-- >>> runjs $ valToNumber (0.0 :: Double)

144+-- >>> testJSC $ valToNumber (0.0 :: Double)

145145-- 0.0

146−-- >>> runjs $ valToNumber ""

146+-- >>> testJSC $ valToNumber ""

147147-- 0.0

148−-- >>> runjs $ valToNumber "1"

148+-- >>> testJSC $ valToNumber "1"

149149-- 1.0

150150valToNumber :: MakeValueRef val => val -> JSC JSNumber

151151valToNumber val = do

@@ -156,21 +156,21 @@ valToNumber val = do

156156-- | Given a JavaScript value get its string value (as a JavaScript string).

157157-- May throw JSException.

158158--

159−-- >>> runjs $ valToStr JSNull >>= strToText

159+-- >>> testJSC $ valToStr JSNull >>= strToText

160160-- "null"

161−-- >>> runjs $ valToStr () >>= strToText

161+-- >>> testJSC $ valToStr () >>= strToText

162162-- "undefined"

163−-- >>> runjs $ valToStr True >>= strToText

163+-- >>> testJSC $ valToStr True >>= strToText

164164-- "true"

165−-- >>> runjs $ valToStr False >>= strToText

165+-- >>> testJSC $ valToStr False >>= strToText

166166-- "false"

167−-- >>> runjs $ valToStr (1.0 :: Double) >>= strToText

167+-- >>> testJSC $ valToStr (1.0 :: Double) >>= strToText

168168-- "1"

169−-- >>> runjs $ valToStr (0.0 :: Double) >>= strToText

169+-- >>> testJSC $ valToStr (0.0 :: Double) >>= strToText

170170-- "0"

171−-- >>> runjs $ valToStr "" >>= strToText

171+-- >>> testJSC $ valToStr "" >>= strToText

172172-- ""

173−-- >>> runjs $ valToStr "1" >>= strToText

173+-- >>> testJSC $ valToStr "1" >>= strToText

174174-- "1"

175175valToStr :: MakeValueRef val => val -> JSC JSStringRef

176176valToStr val = do

@@ -181,21 +181,21 @@ valToStr val = do

181181-- | Given a JavaScript value get its string value (as a Haskell 'Text').

182182-- May throw JSException.

183183--

184−-- >>> runjs $ valToText JSNull

184+-- >>> testJSC $ valToText JSNull

185185-- "null"

186−-- >>> runjs $ valToText ()

186+-- >>> testJSC $ valToText ()

187187-- "undefined"

188−-- >>> runjs $ valToText True

188+-- >>> testJSC $ valToText True

189189-- "true"

190−-- >>> runjs $ valToText False

190+-- >>> testJSC $ valToText False

191191-- "false"

192−-- >>> runjs $ valToText (1.0 :: Double)

192+-- >>> testJSC $ valToText (1.0 :: Double)

193193-- "1"

194−-- >>> runjs $ valToText (0.0 :: Double)

194+-- >>> testJSC $ valToText (0.0 :: Double)

195195-- "0"

196−-- >>> runjs $ valToText ""

196+-- >>> testJSC $ valToText ""

197197-- ""

198−-- >>> runjs $ valToText "1"

198+-- >>> testJSC $ valToText "1"

199199-- "1"

200200valToText :: MakeValueRef val => val -> JSC Text

201201valToText jsvar = valToStr jsvar >>= strToText

@@ -203,21 +203,21 @@ valToText jsvar = valToStr jsvar >>= strToText

203203-- | Given a JavaScript value get its object value.

204204-- May throw JSException.

205205--

206−-- >>> runjs $ (valToObject JSNull >>= valToText) `catch` \ (JSException e) -> valToText e

206+-- >>> testJSC $ (valToObject JSNull >>= valToText) `catch` \ (JSException e) -> valToText e

207207-- "TypeError: 'null' is not an object"

208−-- >>> runjs $ (valToObject () >>= valToText) `catch` \ (JSException e) -> valToText e

208+-- >>> testJSC $ (valToObject () >>= valToText) `catch` \ (JSException e) -> valToText e

209209-- "TypeError: 'undefined' is not an object"

210−-- >>> runjs $ valToObject True

210+-- >>> testJSC $ $ valToObject True

211211-- "true"

212−-- >>> runjs $ valToObject False

212+-- >>> testJSC $ valToObject False

213213-- "false"

214−-- >>> runjs $ valToObject (1.0 :: Double)

214+-- >>> testJSC $ valToObject (1.0 :: Double)

215215-- "1"

216−-- >>> runjs $ valToObject (0.0 :: Double)

216+-- >>> testJSC $ valToObject (0.0 :: Double)

217217-- "0"

218−-- >>> runjs $ valToObject ""

218+-- >>> testJSC $ valToObject ""

219219-- ""

220−-- >>> runjs $ valToObject "1"

220+-- >>> testJSC $ valToObject "1"

221221-- "1"

222222valToObject :: MakeValueRef val => val -> JSC JSObjectRef

223223valToObject val = do

@@ -310,8 +310,7 @@ instance MakeArgRefs Double where

310310valMakeString :: Text -> JSC JSValueRef

311311valMakeString text = do

312312 gctxt <- ask

313− s <- textToStr text

314− liftIO $ jsvaluemakestring gctxt s

313+ liftIO $ jsvaluemakestring gctxt (textToStr text)

315314

316315-- | Makes a JavaScript string

317316instance MakeValueRef Text where

@@ -327,23 +326,23 @@ instance MakeValueRef String where

327326

328327-- | Derefernce a value reference.

329328--

330−-- >>> runjs $ deRefVal JSNull

329+-- >>> testJSC $ deRefVal JSNull

331330-- ValNull

332−-- >>> runjs $ deRefVal ()

331+-- >>> testJSC $ deRefVal ()

333332-- ValUndefined

334−-- >>> runjs $ deRefVal True

333+-- >>> testJSC $ deRefVal True

335334-- ValBool True

336−-- >>> runjs $ deRefVal False

335+-- >>> testJSC $ deRefVal False

337336-- ValBool False

338−-- >>> runjs $ deRefVal (1.0 :: Double)

337+-- >>> testJSC $ deRefVal (1.0 :: Double)

339338-- ValNumber 1.0

340−-- >>> runjs $ deRefVal (0.0 :: Double)

339+-- >>> testJSC $ deRefVal (0.0 :: Double)

341340-- ValNumber 0.0

342−-- >>> runjs $ deRefVal ""

341+-- >>> testJSC $ deRefVal ""

343342-- ValString ""

344−-- >>> runjs $ deRefVal "1"

343+-- >>> testJSC $ deRefVal "1"

345344-- ValString "1"

346−-- >>> runjs $ valToObject True >>= deRefVal

345+-- >>> testJSC $ valToObject True >>= deRefVal

347346-- ValObject 0x...

348347deRefVal :: MakeValueRef val => val -> JSC JSValue

349348deRefVal val = do

@@ -360,15 +359,15 @@ deRefVal val = do

360359

361360-- | Make a JavaScript value out of a 'JSValue' ADT.

362361--

363−-- >>> runjs $ valMakeRef ValNull

362+-- >>> testJSC $ valMakeRef ValNull

364363-- "null"

365−-- >>> runjs $ valMakeRef ValUndefined

364+-- >>> testJSC $ valMakeRef ValUndefined

366365-- "undefined"

367−-- >>> runjs $ valMakeRef (ValBool True)

366+-- >>> testJSC $ valMakeRef (ValBool True)

368367-- "true"

369−-- >>> runjs $ valMakeRef (ValNumber 1)

368+-- >>> testJSC $ valMakeRef (ValNumber 1)

370369-- "1"

371−-- >>> runjs $ valMakeRef (ValString $ pack "Hello")

370+-- >>> testJSC $ valMakeRef (ValString $ pack "Hello")

372371-- "Hello"

373372valMakeRef :: JSValue -> JSC JSValueRef

374373valMakeRef val =

tests/TestJSC.hs+51−9

@@ -1,4 +1,5 @@

11{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE NoMonomorphismRestriction #-}

23-----------------------------------------------------------------------------

34--

45-- Module : TestJSC

@@ -38,49 +39,90 @@ import Data.Text (Text)

3839import qualified Data.Text as T

3940import Control.Applicative

4041import Control.Monad.IO.Class (MonadIO(..))

42+import Control.Monad (when)

43+import System.Log.Logger (debugM)

44+import Control.Lens.Getter ((^.))

4145

4246data TestState = TestState { jsContext :: JSContextRef, window :: Window }

4347

4448state = unsafePerformIO $ newMVar Nothing

4549done = unsafePerformIO $ newEmptyMVar

4650

47−runjs f = do

51+-- >>> testJSC $ ((global ^. js "console" . js "log") # ["Hello"])

52+testJSC :: MakeValueRef val => JSC val -> IO Text

53+testJSC = testJSC' False

54+

55+-- >>> showJSC $ eval "document.body.innerHTML = 'Test'"

56+showJSC :: MakeValueRef val => JSC val -> IO Text

57+showJSC = testJSC' True

58+

59+debugLog = debugM "jsc"

60+

61+testJSC' :: MakeValueRef val => Bool -> JSC val -> IO Text

62+testJSC' show f = do

63+ debugLog "taking done"

4864 tryTakeMVar done

65+ debugLog "taking state"

4966 mbState <- takeMVar state

5067 TestState {..} <- case mbState of

5168 Nothing -> do

69+ debugLog "newState"

5270 newState <- newEmptyMVar

71+ debugLog "fork"

5372 forkIO $ do

73+ debugLog "initGUI"

5474 initGUI

75+ debugLog "windowNew"

5576 window <- windowNew

77+ debugLog "timeoutAdd"

5678 timeoutAddFull (yield >> return True) priorityHigh 10

57−-- windowSetDefaultSize window 900 600

58−-- windowSetPosition window WinPosCenter

79+ windowSetDefaultSize window 900 600

80+ windowSetPosition window WinPosCenter

5981 scrollWin <- scrolledWindowNew Nothing Nothing

6082 webView <- webViewNew

6183 window `containerAdd` scrollWin

6284 scrollWin `containerAdd` webView

6385 window `onDestroy` do

86+ debugLog "onDestroy"

6487 tryTakeMVar state

88+ debugLog "put state"

6589 putMVar state Nothing

90+ debugLog "mainQuit"

6691 mainQuit

92+ debugLog "put done"

6793 putMVar done ()

94+ debugLog "get context"

6895 jsContext <- webViewGetMainFrame webView >>= webFrameGetGlobalContext

96+ debugLog "put initial state"

6997 putMVar newState TestState {..}

70−-- widgetShowAll window

98+ debugLog "maybe show"

99+ when show $ widgetShowAll window

100+ debugLog "mainGUI"

71101 mainGUI

102+ debugLog "mainGUI exited"

72103 takeMVar newState

73− Just s -> return s

74− x <- postGUISync $ runReaderT ((f >>= valToText) `catch` \ (JSException e) -> valToText e) jsContext

104+ Just s@TestState {..} -> do

105+ debugLog "maybe show (2)"

106+ when show . postGUISync $ widgetShowAll window

107+ return s

108+ x <- postGUISync $ runReaderT ((f >>= valToText)

109+ `catch` \ (JSException e) -> valToText e) jsContext

110+ debugLog "put state"

75111 putMVar state $ Just TestState {..}

76112 return x

77113

78114main = do

79− runjs $ return ()

115+ testJSC $ return ()

80116 Just TestState{..} <- takeMVar state

81117 postGUIAsync $ widgetDestroy window

82118 takeMVar done

83119

84−test = runjs $ global ! "console" ! "log" # ["Hello"]

85120

86−test2 = runjs $ eval "'Test'" >>= valToText

121+

122+

123+

124+

125+

126+

127+

128+