5fd6ce0 · jsaddle · git.iko.soy

git.iko.soy/jsaddle

on master help sign in

Update examples

5fd6ce0Hamish Mackenzie14 years ago

src/Language/Javascript/JSC/Evaluate.hs+3−3

compare with master

unifiedsplit

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

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

35--

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"

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

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

39 => script -- ^ JavaScript to evaluate

40 -> this

@@ -48,8 +48,8 @@ evaluateScript script this url line = do

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

50--

51−-- >>> runjs $ eval "1+1"

51+-- >>> testJSC $ eval "1+1"

52−-- "2"

52+-- 2

53eval :: MakeStringRef script

54 => script -- ^ JavaScript to evaluate

55 -> JSC JSValueRef

src/Language/Javascript/JSC/Object.hs+13−13

@@ -115,7 +115,7 @@ instance MakeObjectRef v => MakeObjectRef (JSC v) where

115--

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

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

118−-- "11"

118+-- 11

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

120 => this -- ^ Object to look on

121 -> name -- ^ Name of the property to find

@@ -132,7 +132,7 @@ this ! name = do

132--

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

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

135−-- "W"

135+-- W

136(!!) :: (MakeObjectRef this)

137 => this -- ^ Object to look on

138 -> CUInt -- ^ Index of the property to lookup

@@ -147,7 +147,7 @@ this !! index = do

147--

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

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

150−-- "11"

150+-- 11

151js :: (MakeObjectRef s, MakeStringRef name)

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

153 -> IndexPreservingGetter s (JSC JSPropRef)

@@ -157,7 +157,7 @@ js name = to (!name)

157--

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

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

160−-- "11"

160+-- 11

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

162jsg name = global ! name

163

@@ -165,7 +165,7 @@ jsg name = global ! name

165--

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

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

168−-- "6"

168+-- 6

169infixr 2 #

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

171 => prop -> args -> JSC JSValueRef

@@ -178,7 +178,7 @@ prop # args = do

178--

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

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

181−-- "1"

181+-- 1

182infixr 0 <#

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

184 => prop -- ^ Property to set

@@ -192,7 +192,7 @@ prop <# val = do

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

193--

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

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

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

196new :: (MakeObjectRef constructor, MakeArgRefs args)

197 => constructor

198 -> args

@@ -205,7 +205,7 @@ new constructor args = do

205--

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

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

208−-- "Hello"

208+-- Hello

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

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

211call function this args = do

@@ -236,9 +236,9 @@ type JSCallAsFunction = JSValueRef -- ^ Function object

236-- a to a JavaScipt one.

237--

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) ]

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

240−-- "Hello"

240+-- Hello

241−-- "undefined"

241+-- undefined

242fun :: JSCallAsFunction -> JSCallAsFunction

243fun = id

244

@@ -287,10 +287,10 @@ makeArray args exceptions = do

287--

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

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

290−-- "World"

290+-- World

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

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

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

293+-- Hello,,,true,1

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

295array = rethrow . makeArray

296

src/Language/Javascript/JSC/Value.hs+51−51

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

107-- All values in JavaScript convert to bool.

108--

109-- >>> testJSC $ valToBool JSNull

110−-- False

110+-- false

111-- >>> testJSC $ valToBool ()

112−-- False

112+-- false

113-- >>> testJSC $ valToBool True

114−-- True

114+-- true

115-- >>> testJSC $ valToBool False

116−-- False

116+-- false

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

118−-- True

118+-- true

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

120−-- False

120+-- false

121-- >>> testJSC $ valToBool ""

122−-- False

122+-- false

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

124−-- True

124+-- true

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

126valToBool val = do

127 gctxt <- ask

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

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

132-- May throw JSException.

133--

134−-- >>> testJSC $ valToNumber JSNull

134+-- >>> testJSC $ show <$> valToNumber JSNull

135-- 0.0

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

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

137-- NaN

138−-- >>> testJSC $ valToNumber True

138+-- >>> testJSC $ show <$> valToNumber True

139-- 1.0

140−-- >>> testJSC $ valToNumber False

140+-- >>> testJSC $ show <$> valToNumber False

141-- 0.0

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

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

143−-- 0.0

143+-- 1.0

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

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

145-- 0.0

146−-- >>> testJSC $ valToNumber ""

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

147-- 0.0

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

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

149-- 1.0

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

151valToNumber val = do

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

157-- May throw JSException.

158--

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

160−-- "null"

160+-- null

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

162−-- "undefined"

162+-- undefined

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

164−-- "true"

164+-- true

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

166−-- "false"

166+-- false

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

168−-- "1"

168+-- 1

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

170−-- "0"

170+-- 0

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

172−-- ""

172+--

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

174−-- "1"

174+-- 1

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

176valToStr val = do

177 gctxt <- ask

@@ -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−-- >>> testJSC $ valToText JSNull

184+-- >>> testJSC $ show <$> valToText JSNull

185-- "null"

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

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

187-- "undefined"

188−-- >>> testJSC $ valToText True

188+-- >>> testJSC $ show <$> valToText True

189-- "true"

190−-- >>> testJSC $ valToText False

190+-- >>> testJSC $ show <$> valToText False

191-- "false"

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

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

193-- "1"

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

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

195-- "0"

196−-- >>> testJSC $ valToText ""

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

197-- ""

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

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

199-- "1"

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

201valToText jsvar = valToStr jsvar >>= strToText

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

204-- May throw JSException.

205--

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

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

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

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

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

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

210−-- >>> testJSC $ $ valToObject True

210+-- >>> testJSC $ valToObject True

211−-- "true"

211+-- true

212-- >>> testJSC $ valToObject False

213−-- "false"

213+-- false

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

215−-- "1"

215+-- 1

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

217−-- "0"

217+-- 0

218-- >>> testJSC $ valToObject ""

219−-- ""

219+--

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

221−-- "1"

221+-- 1

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

223valToObject val = do

224 gctxt <- ask

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

326

327-- | Derefernce a value reference.

328--

329−-- >>> testJSC $ deRefVal JSNull

329+-- >>> testJSC $ show <$> deRefVal JSNull

330-- ValNull

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

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

332-- ValUndefined

333−-- >>> testJSC $ deRefVal True

333+-- >>> testJSC $ show <$> deRefVal True

334-- ValBool True

335−-- >>> testJSC $ deRefVal False

335+-- >>> testJSC $ show <$> deRefVal False

336-- ValBool False

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

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

338-- ValNumber 1.0

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

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

340-- ValNumber 0.0

341−-- >>> testJSC $ deRefVal ""

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

342-- ValString ""

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

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

344-- ValString "1"

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

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

346-- ValObject 0x...

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

348deRefVal val = do

tests/TestJSC.hs+22−9

@@ -39,9 +39,10 @@ import Data.Text (Text)

39import qualified Data.Text as T

40import Control.Applicative

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

42−import Control.Monad (when)

42+import Control.Monad (forM, when)

43import System.Log.Logger (debugM)

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

45+import Data.Monoid ((<>))

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

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

@@ -49,17 +50,17 @@ state = unsafePerformIO $ newMVar Nothing

49done = unsafePerformIO $ newEmptyMVar

50done = unsafePerformIO $ newEmptyMVar

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

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

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

53+testJSC :: MakeValueRef val => JSC val -> IO ()

53testJSC = testJSC' False

54testJSC = testJSC' False

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

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

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

57+showJSC :: MakeValueRef val => JSC val -> IO ()

57showJSC = testJSC' True

58showJSC = testJSC' True

59debugLog = debugM "jsc"

60debugLog = debugM "jsc"

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

62+testJSC' :: MakeValueRef val => Bool -> JSC val -> IO ()

62−testJSC' show f = do

63+testJSC' showWindow f = do

63 debugLog "taking done"

64 debugLog "taking done"

64 tryTakeMVar done

65 tryTakeMVar done

65 debugLog "taking state"

66 debugLog "taking state"

@@ -96,17 +97,17 @@ testJSC' show f = do

96 debugLog "put initial state"

97 debugLog "put initial state"

97 putMVar newState TestState {..}

98 putMVar newState TestState {..}

98 debugLog "maybe show"

99 debugLog "maybe show"

99− when show $ widgetShowAll window

100+ when showWindow $ widgetShowAll window

100 debugLog "mainGUI"

101 debugLog "mainGUI"

101 mainGUI

102 mainGUI

102 debugLog "mainGUI exited"

103 debugLog "mainGUI exited"

103 takeMVar newState

104 takeMVar newState

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

105 Just s@TestState {..} -> do

105 debugLog "maybe show (2)"

106 debugLog "maybe show (2)"

106− when show . postGUISync $ widgetShowAll window

107+ when showWindow . postGUISync $ widgetShowAll window

107 return s

108 return s

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

109+ x <- postGUISync $ runReaderT ((f >>= valToText >>= liftIO . putStrLn . T.unpack)

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

110+ `catch` \ (JSException e) -> valToText e >>= liftIO . putStrLn . T.unpack) jsContext

110 debugLog "put state"

111 debugLog "put state"

111 putMVar state $ Just TestState {..}

112 putMVar state $ Just TestState {..}

112 return x

113 return x

@@ -117,6 +118,18 @@ main = do

117 postGUIAsync $ widgetDestroy window

118 postGUIAsync $ widgetDestroy window

118 takeMVar done

119 takeMVar done

119

120

121+listWindowProperties = testJSC $ T.pack . show <$> do

122+ window <- jsg "window"

123+ names <- propertyNames window

124+ forM names $ \name -> do

125+ v <- window ^. js name >>= valToText

126+ n <- strToText name

127+ return (n, v)

128+ `catch`

129+ \(JSException e) -> do

130+ n <- strToText name

131+ msg <- valToText e

132+ return (n, (T.pack $ " error ") <> msg)

120

133

121

134

122

135