c974c63 · jsaddle · git.iko.soy

git.iko.soy/jsaddle

on master help sign in

Change runjs to testJSC.

c974c63Hamish Mackenzie14 years ago

jsc.cabal+10−9

compare with master

unifiedsplit

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

1name: jsc

2−version: 0.0.1

2+version: 0.1.0.0

3cabal-version: >=1.10

4license: MIT

5license-file: LICENSE

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

12data-dir: ""

14library

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

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

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

17 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

19 Language.Javascript.JSC.Arguments Language.Javascript.JSC.Classes

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

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

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

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

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

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

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

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

24 exposed: True

25 buildable: True

26 default-language: Haskell2010

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

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

30test-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,

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

33 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

35 type: exitcode-stdio-1.0

36 type: exitcode-stdio-1.0

36 main-is: TestJSC.hs

37 main-is: TestJSC.hs

37 buildable: True

38 buildable: True

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

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

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

35class MakeStringRef a where

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

36+ makeStringRef :: a -> JSStringRef

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

39-- references for use as function arguments

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

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

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

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

35--

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

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

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

39 => script -- ^ JavaScript to evaluate

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

43 -> JSC JSValueRef

44evaluateScript script this url line = do

45 gctxt <- ask

46− sScript <- makeStringRef script

47 thisr <- makeObjectRef this

46 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

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

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

52--

50--

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

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

2{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE TypeSynonymInstances #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE NoMonomorphismRestriction #-}

6+{-# LANGUAGE Rank2Types #-}

5-----------------------------------------------------------------------------

7-----------------------------------------------------------------------------

6--

8--

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

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

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

21 -- * Property lookup

23 -- * Property lookup

22 , (!)

24 , (!)

23 , (!!)

25 , (!!)

26+ , js

27+ , jsg

25 -- * Setting the value of a property

29 -- * Setting the value of a property

26 , (<#)

30 , (<#)

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

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

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

93 (jscontextgetglobalobject)

97 (jscontextgetglobalobject)

94import Language.Javascript.JSC.Properties

98import Language.Javascript.JSC.Properties

99+import Control.Lens

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

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

102

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

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

97instance MakeObjectRef JSObjectRef where

104instance MakeObjectRef JSObjectRef where

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

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

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

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

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

108--

115--

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

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

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

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

111-- "11"

118-- "11"

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

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

113 => this -- ^ Object to look on

120 => this -- ^ Object to look on

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

115 -> JSC JSPropRef -- ^ Property reference

122 -> JSC JSPropRef -- ^ Property reference

116this ! name = do

123this ! name = do

117 rthis <- makeObjectRef this

124 rthis <- makeObjectRef this

118− rname <- makeStringRef name

119 return (JSPropRef rthis rname)

125 return (JSPropRef rthis rname)

126+ where

127+ rname = makeStringRef name

120

128

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

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

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

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

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

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

124--

132--

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

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

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

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

127-- "W"

135-- "W"

128(!!) :: (MakeObjectRef this)

136(!!) :: (MakeObjectRef this)

129 => this -- ^ Object to look on

137 => this -- ^ Object to look on

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

133 rthis <- makeObjectRef this

141 rthis <- makeObjectRef this

134 return (JSPropIndexRef rthis index)

142 return (JSPropIndexRef rthis index)

135

143

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+

136-- | Call a JavaScript function

164-- | Call a JavaScript function

137--

165--

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

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

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

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

140-- "6"

168-- "6"

169+infixr 2 #

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

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

142 => prop -> args -> JSC JSValueRef

171 => prop -> args -> JSC JSValueRef

143prop # args = do

172prop # args = do

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

147

176

148-- | Call a JavaScript function

177-- | Call a JavaScript function

149--

178--

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

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

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

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

152-- "1"

181-- "1"

153infixr 0 <#

182infixr 0 <#

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

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

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

162

191

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

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

164--

193--

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

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

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

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

167new :: (MakeObjectRef constructor, MakeArgRefs args)

196new :: (MakeObjectRef constructor, MakeArgRefs args)

168 => constructor

197 => constructor

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

174

203

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

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

176--

205--

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

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

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

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

179-- "Hello"

208-- "Hello"

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

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

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

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

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

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

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

207-- a to a JavaScipt one.

236-- a to a JavaScipt one.

208--

237--

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

238+-- >>> testJSC $ 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) ]

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

211-- "Hello"

240-- "Hello"

212-- "undefined"

241-- "undefined"

213fun :: JSCallAsFunction -> JSCallAsFunction

242fun :: JSCallAsFunction -> JSCallAsFunction

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

225function name f = do

254function name f = do

226 gctxt <- ask

255 gctxt <- ask

227 callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap

256 callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap

228− sName <- makeStringRef name

229− liftIO $ jsobjectmakefunctionwithcallback gctxt sName callback

257+ liftIO $ jsobjectmakefunctionwithcallback gctxt (makeStringRef name) callback

230 where

258 where

231 wrap ctx fobj this argc argv exception = do

259 wrap ctx fobj this argc argv exception = do

232 args <- peekArray (fromIntegral argc) argv

260 args <- peekArray (fromIntegral argc) argv

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

257

285

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

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

259--

287--

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

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

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

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

262-- "World"

290-- "World"

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

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

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

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

265-- "Hello,,,true,1"

293-- "Hello,,,true,1"

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

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

267array = rethrow . makeArray

295array = rethrow . makeArray

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

270global :: JSC JSObjectRef

298global :: JSC JSObjectRef

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

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

272

300

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−

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

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

282instance MakeObjectRef String where

302instance MakeObjectRef String where

283 makeObjectRef name = do

303 makeObjectRef name = do

284 this <- global

304 this <- global

285− rname <- makeStringRef name

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

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

287

306

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

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

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

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

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

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

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

83objGetPropertyByName this name exceptions = do

84 gctxt <- ask

85− sName <- makeStringRef name

86− liftIO $ jsobjectgetproperty gctxt this sName exceptions

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

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

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

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

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

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

124 -> JSC ()

123 -> JSC ()

125objSetPropertyByName this name val attributes exceptions = do

124objSetPropertyByName this name val attributes exceptions = do

126 gctxt <- ask

125 gctxt <- ask

127− sName <- makeStringRef name

128 vref <- makeValueRef val

126 vref <- makeValueRef val

129− liftIO $ jsobjectsetproperty gctxt this sName vref attributes exceptions

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

130

128

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

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

132objSetPropertyAtIndex :: (MakeValueRef val)

130objSetPropertyAtIndex :: (MakeValueRef val)

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

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

32import Data.Text.Foreign (useAsPtr)

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

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

35+import System.IO.Unsafe (unsafePerformIO)

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

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

37instance MakeStringRef JSStringRef where

38instance MakeStringRef JSStringRef where

38− makeStringRef = return

39+ makeStringRef = id

40instance MakeStringRef Text where

41instance MakeStringRef Text where

41 makeStringRef = textToStr

42 makeStringRef = textToStr

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

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

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

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

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

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

55+textToStr :: Text -> JSStringRef

55textToStr text =

56textToStr text =

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

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

57 jsstringcreatewithcharacters (castPtr p) (fromIntegral l)

58 jsstringcreatewithcharacters (castPtr p) (fromIntegral l)

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

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

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

107-- All values in JavaScript convert to bool.

108--

109−-- >>> runjs $ valToBool JSNull

109+-- >>> testJSC $ valToBool JSNull

110-- False

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

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

112-- False

113−-- >>> runjs $ valToBool True

113+-- >>> testJSC $ valToBool True

114-- True

115−-- >>> runjs $ valToBool False

115+-- >>> testJSC $ valToBool False

116-- False

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

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

118-- True

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

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

120-- False

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

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

122-- False

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

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

124-- True

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

126valToBool val = do

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

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

132-- May throw JSException.

133--

134−-- >>> runjs $ valToNumber JSNull

134+-- >>> testJSC $ valToNumber JSNull

135-- 0.0

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

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

137-- NaN

138−-- >>> runjs $ valToNumber True

138+-- >>> testJSC $ valToNumber True

139-- 1.0

140−-- >>> runjs $ valToNumber False

140+-- >>> testJSC $ valToNumber False

141-- 0.0

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

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

143-- 0.0

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

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

145-- 0.0

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

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

147-- 0.0

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

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

149-- 1.0

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

151valToNumber val = do

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

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

157-- May throw JSException.

158--

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

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

160-- "null"

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

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

162-- "undefined"

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

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

164-- "true"

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

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

166-- "false"

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

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

168-- "1"

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

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

170-- "0"

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

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

172-- ""

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

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

174-- "1"

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

176valToStr val = do

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

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

182-- May throw JSException.

183--

184−-- >>> runjs $ valToText JSNull

184+-- >>> testJSC $ valToText JSNull

185-- "null"

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

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

187-- "undefined"

188−-- >>> runjs $ valToText True

188+-- >>> testJSC $ valToText True

189-- "true"

190−-- >>> runjs $ valToText False

190+-- >>> testJSC $ valToText False

191-- "false"

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

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

193-- "1"

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

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

195-- "0"

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

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

197-- ""

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

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

199-- "1"

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

201valToText jsvar = valToStr jsvar >>= strToText

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

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

204-- May throw JSException.

205--

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

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

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

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

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

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

210−-- >>> runjs $ valToObject True

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

211-- "true"

212−-- >>> runjs $ valToObject False

212+-- >>> testJSC $ valToObject False

213-- "false"

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

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

215-- "1"

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

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

217-- "0"

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

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

219-- ""

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

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

221-- "1"

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

223valToObject val = do

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

310valMakeString :: Text -> JSC JSValueRef

311valMakeString text = do

312 gctxt <- ask

313− s <- textToStr text

314− liftIO $ jsvaluemakestring gctxt s

313+ liftIO $ jsvaluemakestring gctxt (textToStr text)

315

314

316-- | Makes a JavaScript string

315-- | Makes a JavaScript string

317instance MakeValueRef Text where

316instance MakeValueRef Text where

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

327

326

328-- | Derefernce a value reference.

327-- | Derefernce a value reference.

329--

328--

330−-- >>> runjs $ deRefVal JSNull

329+-- >>> testJSC $ deRefVal JSNull

331-- ValNull

330-- ValNull

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

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

333-- ValUndefined

332-- ValUndefined

334−-- >>> runjs $ deRefVal True

333+-- >>> testJSC $ deRefVal True

335-- ValBool True

334-- ValBool True

336−-- >>> runjs $ deRefVal False

335+-- >>> testJSC $ deRefVal False

337-- ValBool False

336-- ValBool False

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

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

339-- ValNumber 1.0

338-- ValNumber 1.0

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

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

341-- ValNumber 0.0

340-- ValNumber 0.0

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

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

343-- ValString ""

342-- ValString ""

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

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

345-- ValString "1"

344-- ValString "1"

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

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

347-- ValObject 0x...

346-- ValObject 0x...

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

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

349deRefVal val = do

348deRefVal val = do

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

360

359

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

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

362--

361--

363−-- >>> runjs $ valMakeRef ValNull

362+-- >>> testJSC $ valMakeRef ValNull

364-- "null"

363-- "null"

365−-- >>> runjs $ valMakeRef ValUndefined

364+-- >>> testJSC $ valMakeRef ValUndefined

366-- "undefined"

365-- "undefined"

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

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

368-- "true"

367-- "true"

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

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

370-- "1"

369-- "1"

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

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

372-- "Hello"

371-- "Hello"

373valMakeRef :: JSValue -> JSC JSValueRef

372valMakeRef :: JSValue -> JSC JSValueRef

374valMakeRef val =

373valMakeRef val =

tests/TestJSC.hs+51−9

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

1{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE NoMonomorphismRestriction #-}

2-----------------------------------------------------------------------------

3-----------------------------------------------------------------------------

3--

4--

4-- Module : TestJSC

5-- Module : TestJSC

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

38import qualified Data.Text as T

39import qualified Data.Text as T

39import Control.Applicative

40import Control.Applicative

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

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

42+import Control.Monad (when)

43+import System.Log.Logger (debugM)

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

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

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

44state = unsafePerformIO $ newMVar Nothing

48state = unsafePerformIO $ newMVar Nothing

45done = unsafePerformIO $ newEmptyMVar

49done = unsafePerformIO $ newEmptyMVar

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"

48 tryTakeMVar done

64 tryTakeMVar done

65+ debugLog "taking state"

49 mbState <- takeMVar state

66 mbState <- takeMVar state

50 TestState {..} <- case mbState of

67 TestState {..} <- case mbState of

51 Nothing -> do

68 Nothing -> do

69+ debugLog "newState"

52 newState <- newEmptyMVar

70 newState <- newEmptyMVar

71+ debugLog "fork"

53 forkIO $ do

72 forkIO $ do

73+ debugLog "initGUI"

54 initGUI

74 initGUI

75+ debugLog "windowNew"

55 window <- windowNew

76 window <- windowNew

77+ debugLog "timeoutAdd"

56 timeoutAddFull (yield >> return True) priorityHigh 10

78 timeoutAddFull (yield >> return True) priorityHigh 10

57−-- windowSetDefaultSize window 900 600

79+ windowSetDefaultSize window 900 600

58−-- windowSetPosition window WinPosCenter

80+ windowSetPosition window WinPosCenter

59 scrollWin <- scrolledWindowNew Nothing Nothing

81 scrollWin <- scrolledWindowNew Nothing Nothing

60 webView <- webViewNew

82 webView <- webViewNew

61 window `containerAdd` scrollWin

83 window `containerAdd` scrollWin

62 scrollWin `containerAdd` webView

84 scrollWin `containerAdd` webView

63 window `onDestroy` do

85 window `onDestroy` do

86+ debugLog "onDestroy"

64 tryTakeMVar state

87 tryTakeMVar state

88+ debugLog "put state"

65 putMVar state Nothing

89 putMVar state Nothing

90+ debugLog "mainQuit"

66 mainQuit

91 mainQuit

92+ debugLog "put done"

67 putMVar done ()

93 putMVar done ()

94+ debugLog "get context"

68 jsContext <- webViewGetMainFrame webView >>= webFrameGetGlobalContext

95 jsContext <- webViewGetMainFrame webView >>= webFrameGetGlobalContext

96+ debugLog "put initial state"

69 putMVar newState TestState {..}

97 putMVar newState TestState {..}

98+ debugLog "maybe show"

70−-- widgetShowAll window

99+ when show $ widgetShowAll window

100+ debugLog "mainGUI"

71 mainGUI

101 mainGUI

102+ debugLog "mainGUI exited"

72 takeMVar newState

103 takeMVar newState

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

105+ debugLog "maybe show (2)"

106+ when show . postGUISync $ widgetShowAll window

73− Just s -> return s

107+ return s

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

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

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

110+ debugLog "put state"

75 putMVar state $ Just TestState {..}

111 putMVar state $ Just TestState {..}

76 return x

112 return x

113

78main = do

114main = do

79− runjs $ return ()

115+ testJSC $ return ()

80 Just TestState{..} <- takeMVar state

116 Just TestState{..} <- takeMVar state

81 postGUIAsync $ widgetDestroy window

117 postGUIAsync $ widgetDestroy window

82 takeMVar done

118 takeMVar done

119

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

120

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

121+

122+

123+

124+

125+

126+

127+

128+