5fd6ce0 · jsaddle · git.iko.soy

git.iko.soy/jsaddle

Update examples

commit5fd6ce0fd91ecbaf2e59fca985402ee7d447a578 authorHamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> dateTue 12 Feb 2013, 02:48 (14 years ago) parentd3f2bf2

4 files changed+89−76

compare with master

unifiedsplit

src/Language/Javascript/JSC/Evaluate.hs+3−3 src/Language/Javascript/JSC/Object.hs+13−13 src/Language/Javascript/JSC/Value.hs+51−51 tests/TestJSC.hs+22−9

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

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

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

3535--

3636-- >>> 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

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

3939 => script -- ^ JavaScript to evaluate

4040 -> this

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

4848

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

5050--

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

52−-- "2"

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

52+-- 2

5353eval :: MakeStringRef script

5454 => script -- ^ JavaScript to evaluate

5555 -> JSC JSValueRef

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

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

115115--

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

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

118−-- "11"

118+-- 11

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

120120 => this -- ^ Object to look on

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

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

132132--

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

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

135−-- "W"

135+-- W

136136(!!) :: (MakeObjectRef this)

137137 => this -- ^ Object to look on

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

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

147147--

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

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

150−-- "11"

150+-- 11

151151js :: (MakeObjectRef s, MakeStringRef name)

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

153153 -> IndexPreservingGetter s (JSC JSPropRef)

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

157157--

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

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

160−-- "11"

160+-- 11

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

162162jsg name = global ! name

163163

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

165165--

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

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

168−-- "6"

168+-- 6

169169infixr 2 #

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

171171 => prop -> args -> JSC JSValueRef

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

178178--

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

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

181−-- "1"

181+-- 1

182182infixr 0 <#

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

184184 => prop -- ^ Property to set

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

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

193193--

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

196196new :: (MakeObjectRef constructor, MakeArgRefs args)

197197 => constructor

198198 -> args

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

205205--

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

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

208−-- "Hello"

208+-- Hello

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

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

211211call function this args = do

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

236236-- a to a JavaScipt one.

237237--

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

240−-- "Hello"

241−-- "undefined"

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

240+-- Hello

241+-- undefined

242242fun :: JSCallAsFunction -> JSCallAsFunction

243243fun = id

244244

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

287287--

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

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

290−-- "World"

290+-- World

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

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

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

293+-- Hello,,,true,1

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

295295array = rethrow . makeArray

296296

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

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

107107-- All values in JavaScript convert to bool.

108108--

109109-- >>> testJSC $ valToBool JSNull

110−-- False

110+-- false

111111-- >>> testJSC $ valToBool ()

112−-- False

112+-- false

113113-- >>> testJSC $ valToBool True

114−-- True

114+-- true

115115-- >>> testJSC $ valToBool False

116−-- False

116+-- false

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

118−-- True

118+-- true

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

120−-- False

120+-- false

121121-- >>> testJSC $ valToBool ""

122−-- False

122+-- false

123123-- >>> testJSC $ valToBool "1"

124−-- True

124+-- true

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

126126valToBool val = do

127127 gctxt <- ask

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

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

132132-- May throw JSException.

133133--

134−-- >>> testJSC $ valToNumber JSNull

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

135135-- 0.0

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

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

137137-- NaN

138−-- >>> testJSC $ valToNumber True

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

139139-- 1.0

140−-- >>> testJSC $ valToNumber False

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

141141-- 0.0

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

143−-- 0.0

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

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

143+-- 1.0

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

145145-- 0.0

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

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

147147-- 0.0

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

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

149149-- 1.0

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

151151valToNumber val = do

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

157157-- May throw JSException.

158158--

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

160−-- "null"

160+-- null

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

162−-- "undefined"

162+-- undefined

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

164−-- "true"

164+-- true

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

166−-- "false"

166+-- false

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

168−-- "1"

168+-- 1

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

170−-- "0"

170+-- 0

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

172−-- ""

172+--

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

174−-- "1"

174+-- 1

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

176176valToStr val = do

177177 gctxt <- ask

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

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

185185-- "null"

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

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

187187-- "undefined"

188−-- >>> testJSC $ valToText True

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

189189-- "true"

190−-- >>> testJSC $ valToText False

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

191191-- "false"

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

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

193193-- "1"

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

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

195195-- "0"

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

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

197197-- ""

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

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

199199-- "1"

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

201201valToText jsvar = valToStr jsvar >>= strToText

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

204204-- May throw JSException.

205205--

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

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

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

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

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

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

211−-- "true"

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

210+-- >>> testJSC $ valToObject True

211+-- true

212212-- >>> testJSC $ valToObject False

213−-- "false"

213+-- false

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

215−-- "1"

215+-- 1

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

217−-- "0"

217+-- 0

218218-- >>> testJSC $ valToObject ""

219−-- ""

219+--

220220-- >>> testJSC $ valToObject "1"

221−-- "1"

221+-- 1

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

223223valToObject val = do

224224 gctxt <- ask

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

326326

327327-- | Derefernce a value reference.

328328--

329−-- >>> testJSC $ deRefVal JSNull

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

330330-- ValNull

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

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

332332-- ValUndefined

333−-- >>> testJSC $ deRefVal True

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

334334-- ValBool True

335−-- >>> testJSC $ deRefVal False

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

336336-- ValBool False

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

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

338338-- ValNumber 1.0

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

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

340340-- ValNumber 0.0

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

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

342342-- ValString ""

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

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

344344-- ValString "1"

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

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

346346-- ValObject 0x...

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

348348deRefVal val = do

tests/TestJSC.hs+22−9

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

3939import qualified Data.Text as T

4040import Control.Applicative

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

42−import Control.Monad (when)

42+import Control.Monad (forM, when)

4343import System.Log.Logger (debugM)

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

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

4546

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

4748

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

4950done = unsafePerformIO $ newEmptyMVar

5051

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

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

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

5354testJSC = testJSC' False

5455

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

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

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

5758showJSC = testJSC' True

5859

5960debugLog = debugM "jsc"

6061

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

62−testJSC' show f = do

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

63+testJSC' showWindow f = do

6364 debugLog "taking done"

6465 tryTakeMVar done

6566 debugLog "taking state"

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

9697 debugLog "put initial state"

9798 putMVar newState TestState {..}

9899 debugLog "maybe show"

99− when show $ widgetShowAll window

100+ when showWindow $ widgetShowAll window

100101 debugLog "mainGUI"

101102 mainGUI

102103 debugLog "mainGUI exited"

103104 takeMVar newState

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

105106 debugLog "maybe show (2)"

106− when show . postGUISync $ widgetShowAll window

107+ when showWindow . postGUISync $ widgetShowAll window

107108 return s

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

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

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

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

110111 debugLog "put state"

111112 putMVar state $ Just TestState {..}

112113 return x

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

117118 postGUIAsync $ widgetDestroy window

118119 takeMVar done

119120

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)

120133

121134

122135