ca30a84 · jsaddle · git.iko.soy

git.iko.soy/jsaddle

Bug fixes and doctest fixes

The tests have been broken for a while and this should fix them and a couple of bugs to do with the handling of null strings. Not super keen on allowing null strings, but if you make one in JS land it we should not crash. Perhaps we can change it in a future version to throw an exception or make all string functions to return Maybe.

commitca30a84673a2db98a90cd33c6f0ec2bcaa7e230d authorHamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> dateTue 29 Mar 2016, 00:14 (11 years ago) parent9c42512

7 files changed+99−51

compare with master

unifiedsplit

jsaddle.cabal+3−3 src/Language/Javascript/JSaddle/Evaluate.hs+3−1 src/Language/Javascript/JSaddle/Native.hs+7−2 src/Language/Javascript/JSaddle/Object.hs+40−22 src/Language/Javascript/JSaddle/Test.hs+1−1 src/Language/Javascript/JSaddle/Value.hs+23−21 tests/DocTest.hs+22−1

jsaddle.cabal+3−3

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

11name: jsaddle

2−version: 0.3.0.1

2+version: 0.3.0.2

33cabal-version: >=1.10

44build-type: Simple

55license: MIT

@@ -32,12 +32,12 @@ library

3232 build-depends:

3333 gtk3 >=0.14.2 && <0.15,

3434 webkitgtk3 >=0.13.0.0 && <0.15,

35− webkitgtk3-javascriptcore >=0.13.0.0 && <0.14

35+ webkitgtk3-javascriptcore >=0.13.1.2 && <0.14

3636 else

3737 build-depends:

3838 gtk >=0.14.2 && <0.15,

3939 webkit >=0.13.0.0 && <0.15,

40− webkit-javascriptcore >=0.13.0.0 && <0.14

40+ webkit-javascriptcore >=0.13.1.2 && <0.14

4141 build-depends:

4242 glib -any

4343 exposed-modules:

src/Language/Javascript/JSaddle/Evaluate.hs+3−1

@@ -47,12 +47,14 @@ import Language.Javascript.JSaddle.Monad (JSM)

4747-- >>> import Language.Javascript.JSaddle.Object (global, array, (!))

4848-- >>> import Language.Javascript.JSaddle.Monad (catch)

4949-- >>> import Language.Javascript.JSaddle.Exception (JSException(..))

50+-- >>> testJSaddle $ return ()

51+-- ...

5052

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

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

5355--

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

55−-- SyntaxError: Expected token '}',FileName,55

57+-- SyntaxError: Unexpected end of script,FileName,55

5658evaluateScript :: (ToJSString script, MakeObject this, ToJSString url)

5759 => script -- ^ JavaScript to evaluate

5860 -> this

src/Language/Javascript/JSaddle/Native.hs+7−2

@@ -30,8 +30,8 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase

3030 (JSObjectRef, OpaqueJSString, JSStringRef, OpaqueJSContext,

3131 OpaqueJSValue, JSValueRef)

3232import Foreign.ForeignPtr

33− (touchForeignPtr, FinalizerPtr, newForeignPtr, FinalizerEnvPtr,

34− newForeignPtrEnv, ForeignPtr)

33+ (newForeignPtr_, touchForeignPtr, FinalizerPtr, newForeignPtr,

34+ FinalizerEnvPtr, newForeignPtrEnv, ForeignPtr)

3535import Control.Monad.IO.Class (MonadIO, MonadIO(..))

3636import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

3737 (jsvalueprotect)

@@ -41,6 +41,7 @@ import Language.Javascript.JSaddle.Types

4141 (JSM, JSString, Object(..), JSVal)

4242import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

4343import Language.Javascript.JSaddle.Classes (ToJSVal(..), ToJSVal)

44+import Foreign.Ptr (nullPtr)

4445

4546makeNewJSVal :: JSValueRef -> JSM (ForeignPtr OpaqueJSValue)

4647makeNewJSVal val = do

@@ -53,12 +54,16 @@ foreign import ccall unsafe "&JSValueUnprotect"

5354 jsValueUnprotect :: FinalizerEnvPtr OpaqueJSContext OpaqueJSValue

5455

5556makeNewJSString :: MonadIO m => JSStringRef -> m (ForeignPtr OpaqueJSString)

57+makeNewJSString s | s == nullPtr =

58+ liftIO $ newForeignPtr_ s

5659makeNewJSString s =

5760 liftIO $ do

5861 s' <- jsstringretain s

5962 newForeignPtr jsStringRelease s'

6063

6164wrapJSString :: MonadIO m => JSStringRef -> m (ForeignPtr OpaqueJSString)

65+wrapJSString s | s == nullPtr =

66+ liftIO $ newForeignPtr_ s

6267wrapJSString s = liftIO $ newForeignPtr jsStringRelease s

6368

6469foreign import ccall unsafe "&JSStringRelease"

src/Language/Javascript/JSaddle/Object.hs+40−22

@@ -112,8 +112,8 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef

112112 jspropertynamearraygetcount, jsobjectcopypropertynames,

113113 jsobjectcallasconstructor, jsobjectmakearray,

114114 jsobjectcallasfunction,

115− JSObjectCallAsFunctionCallback,

116− jsobjectmakefunctionwithcallback, JSObjectCallAsFunctionCallback')

115+ JSObjectCallAsFunctionCallback, mkJSObjectCallAsFunctionCallback,

116+ jsobjectmakefunctionwithcallback)

117117import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

118118 (jsvaluemakeundefined)

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

@@ -121,8 +121,8 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef

121121import Foreign (peekArray, nullPtr, withArrayLen)

122122import Foreign.Ptr (freeHaskellFunPtr)

123123import Language.Javascript.JSaddle.Native

124− (makeNewJSVal, wrapJSString, withJSVals, withObject, withJSString,

125− withToJSVal)

124+ (makeNewJSString, makeNewJSVal, wrapJSString, withJSVals,

125+ withObject, withJSString, withToJSVal)

126126import System.IO.Unsafe (unsafePerformIO)

127127import Foreign.ForeignPtr (newForeignPtr_)

128128#endif

@@ -147,8 +147,9 @@ import Data.Text (Text)

147147-- $setup

148148-- >>> import Language.Javascript.JSaddle.Test (testJSaddle)

149149-- >>> import Language.Javascript.JSaddle.Evaluate (eval)

150−-- >>> import Language.Javascript.JSaddle.Value (val)

150+-- >>> import Language.Javascript.JSaddle.Value (val, valToText, JSNull(..))

151151-- >>> import Control.Lens.Operators ((^.))

152+-- >>> import qualified Data.Text as T (unpack)

152153

153154-- | Object can be made by evaluating a fnction in 'JSM' as long

154155-- as it returns something we can make into a Object.

@@ -159,6 +160,7 @@ instance MakeObject v => MakeObject (JSM v) where

159160-- | Lookup a property based on its name.

160161--

161162-- >>> testJSaddle $ eval "'Hello World'.length"

163+-- 11

162164-- >>> testJSaddle $ val "Hello World" ! "length"

163165-- 11

164166(!) :: (MakeObject this, ToJSString name)

@@ -175,6 +177,7 @@ this ! name = do

175177-- | Lookup a property based on its index.

176178--

177179-- >>> testJSaddle $ eval "'Hello World'[6]"

180+-- W

178181-- >>> testJSaddle $ val "Hello World" !! 6

179182-- W

180183(!!) :: (MakeObject this)

@@ -191,6 +194,7 @@ this !! index = do

191194-- > js name = to (!name)

192195--

193196-- >>> testJSaddle $ eval "'Hello World'.length"

197+-- 11

194198-- >>> testJSaddle $ val "Hello World" ^. js "length"

195199-- 11

196200js :: (MakeObject s, ToJSString name)

@@ -204,6 +208,7 @@ js name = to (!name)

204208-- > jss name = to (<#name)

205209--

206210-- >>> testJSaddle $ eval "'Hello World'.length"

211+-- 11

207212-- >>> testJSaddle $ val "Hello World" ^. js "length"

208213-- 11

209214jss :: (ToJSString name, ToJSVal val)

@@ -275,8 +280,13 @@ js5 name a0 a1 a2 a3 a4 = jsf name (a0, a1, a2, a3, a4)

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

276281--

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

278−-- >>> testJSaddle $ do w <- jsg "console"; w ^. js "log" # ["Hello World"]

279−-- 11

283+-- ** Message: console message: @1: Hello World

284+-- <BLANKLINE>

285+-- undefined

286+-- >>> testJSaddle $ do w <- jsg "console"; w ^. js1 "log" "Hello World"

287+-- ** Message: console message: [native code] @0: Hello World

288+-- <BLANKLINE>

289+-- undefined

280290jsg :: ToJSString a => a -> JSM JSVal

281291jsg name = global ! name

282292{-# INLINE jsg #-}

@@ -285,9 +295,10 @@ jsg name = global ! name

285295--

286296-- > jsgf name = jsg name . to (# args)

287297--

288−-- >>> testJSaddle $ eval "globalFunc = function(x) {x.length}"

298+-- >>> testJSaddle $ eval "globalFunc = function (x) {return x.length;}"

299+-- function (x) {return x.length;}

289300-- >>> testJSaddle $ jsgf "globalFunc" ["World"]

290−-- 6

301+-- 5

291302jsgf :: (ToJSString name, MakeArgs args) => name -> args -> JSM JSVal

292303jsgf name = global # name

293304{-# INLINE jsgf #-}

@@ -297,7 +308,7 @@ jsgf name = global # name

297308-- > jsg0 name = jsgf name ()

298309--

299310-- >>> testJSaddle $ jsg0 "globalFunc"

300−-- hello world

311+-- TypeError: undefined is not an object (evaluating 'x.length')

301312jsg0 :: (ToJSString name) => name -> JSM JSVal

302313jsg0 name = jsgf name ()

303314{-# INLINE jsg0 #-}

@@ -307,7 +318,7 @@ jsg0 name = jsgf name ()

307318-- > jsg1 name a0 = jsgf name [a0]

308319--

309320-- >>> testJSaddle $ jsg1 "globalFunc" "World"

310−-- 6

321+-- 5

311322jsg1 :: (ToJSString name, ToJSVal a0) => name -> a0 -> JSM JSVal

312323jsg1 name a0 = jsgf name [a0]

313324{-# INLINE jsg1 #-}

@@ -340,6 +351,7 @@ jsg5 name a0 a1 a2 a3 a4 = jsgf name (a0, a1, a2, a3, a4)

340351-- | Call a JavaScript function

341352--

342353-- >>> testJSaddle $ eval "'Hello World'.indexOf('World')"

354+-- 6

343355-- >>> testJSaddle $ val "Hello World" # "indexOf" $ ["World"]

344356-- 6

345357infixr 2 #

@@ -354,8 +366,10 @@ infixr 2 #

354366

355367-- | Call a JavaScript function

356368--

357−-- >>> testJSaddle $ eval "something[6]('World')"

358−-- >>> testJSaddle $ val something ## 6 ["World"]

369+-- >>> testJSaddle $ eval "something = {}; something[6]=function (x) {return x.length;}; something[6]('World')"

370+-- 5

371+-- >>> testJSaddle $ jsg "something" ## 6 $ ["World"]

372+-- 5

359373infixr 2 ##

360374(##) :: (MakeObject this, MakeArgs args)

361375 => this -> Index -> args -> JSM JSVal

@@ -369,7 +383,8 @@ infixr 2 ##

369383-- | Set a JavaScript property

370384--

371385-- >>> testJSaddle $ eval "var j = {}; j.x = 1; j.x"

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

386+-- 1

387+-- >>> testJSaddle $ do {j <- obj; (j <# "x") 1; j!"x"}

373388-- 1

374389infixr 1 <#

375390(<#) :: (MakeObject this, ToJSString name, ToJSVal val)

@@ -385,7 +400,8 @@ infixr 1 <#

385400-- | Set a JavaScript property

386401--

387402-- >>> testJSaddle $ eval "var j = {}; j[6] = 1; j[6]"

388−-- >>> testJSaddle $ do {j <- eval "({})"; j <## 6 1; j!!6}

403+-- 1

404+-- >>> testJSaddle $ do {j <- obj; (j <## 6) 1; j!!6}

389405-- 1

390406infixr 1 <##

391407(<##) :: (MakeObject this, ToJSVal val)

@@ -417,6 +433,7 @@ new constructor args = do

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

418434--

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

436+-- Hello

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

421438-- Hello

422439call :: (MakeObject f, MakeObject this, MakeArgs args)

@@ -430,7 +447,8 @@ call f this args = do

430447-- | Make an empty object using the default constuctor

431448--

432449-- >>> testJSaddle $ eval "var a = {}; a.x = 'Hello'; a.x"

433−-- >>> testJSaddle $ do { a <- obj; a ^. js "x" <# "Hello"; a ^. js "x" }

450+-- Hello

451+-- >>> testJSaddle $ do { a <- obj; (a <# "x") "Hello"; a ^. js "x" }

434452-- Hello

435453obj :: JSM Object

436454#ifdef ghcjs_HOST_OS

@@ -456,6 +474,9 @@ type JSCallAsFunction = JSVal -- ^ Function object

456474-- a to a JavaScipt one.

457475--

458476-- >>> testJSaddle $ eval "(function(f) {f('Hello');})(function (a) {console.log(a)})"

477+-- ** Message: console message: @1: Hello

478+-- <BLANKLINE>

479+-- undefined

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

460481-- Hello

461482-- undefined

@@ -463,11 +484,6 @@ fun :: JSCallAsFunction -> JSCallAsFunction

463484fun = id

464485{-# INLINE fun #-}

465486

466−#if !defined(ghcjs_HOST_OS)

467−foreign import ccall "wrapper"

468− mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback

469−#endif

470−

471487#ifdef ghcjs_HOST_OS

472488type HaskellCallback = Callback (JSVal -> JSVal -> IO ())

473489#else

@@ -557,9 +573,11 @@ makeArray args exceptions = do

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

558574--

559575-- >>> testJSaddle $ eval "['Hello', 'World'][1]"

576+-- World

560577-- >>> testJSaddle $ array ["Hello", "World"] !! 1

561578-- World

562579-- >>> testJSaddle $ eval "['Hello', null, undefined, true, 1]"

580+-- Hello,,,true,1

563581-- >>> testJSaddle $ array ("Hello", JSNull, (), True, 1.0::Double)

564582-- Hello,,,true,1

565583array :: MakeArgs args => args -> JSM Object

@@ -634,7 +652,7 @@ propertyNamesCount names = liftIO $ jspropertynamearraygetcount names

634652

635653-- | Get a name out of a property name array

636654propertyNamesAt :: MonadIO m => JSPropertyNameArray -> CSize -> m JSString

637−propertyNamesAt names index = liftIO $ jspropertynamearraygetnameatindex names index >>= wrapJSString

655+propertyNamesAt names index = liftIO $ jspropertynamearraygetnameatindex names index >>= makeNewJSString

638656{-# INLINE propertyNamesAt #-}

639657

640658-- | Convert property array to a list

src/Language/Javascript/JSaddle/Test.hs+1−1

@@ -62,7 +62,7 @@ showJSaddle :: ToJSVal val => JSM val -> IO ()

6262showJSaddle = testJSaddle' True

6363

6464debugLog :: String -> IO ()

65−debugLog = putStrLn

65+debugLog _ = return ()

6666

6767testJSaddle' :: ToJSVal val => Bool -> JSM val -> IO ()

6868testJSaddle' showWindow f = do

src/Language/Javascript/JSaddle/Value.hs+23−21

@@ -111,6 +111,8 @@ import Data.Int (Int32, Int64)

111111-- >>> import Language.Javascript.JSaddle.Test (testJSaddle)

112112-- >>> import Language.Javascript.JSaddle.Monad (catch)

113113-- >>> import Language.Javascript.JSaddle.Exception (JSException(..))

114+-- >>> import Language.Javascript.JSaddle.Object (obj)

115+-- >>> import qualified Data.Text as T (pack)

114116

115117data JSNull = JSNull -- ^ Type that represents a value that can only be null.

116118 -- Haskell of course has no null so we are adding this type.

@@ -218,7 +220,7 @@ valToNumber value = do

218220-- >>> testJSaddle $ valToStr (0.0 :: Double) >>= strToText

219221-- 0

220222-- >>> testJSaddle $ valToStr "" >>= strToText

221−--

223+-- <BLANKLINE>

222224-- >>> testJSaddle $ valToStr "1" >>= strToText

223225-- 1

224226valToStr :: ToJSVal value => value -> JSM JSString

@@ -263,7 +265,7 @@ valToText jsvar = valToStr jsvar >>= strToText

263265-- >>> testJSaddle $ valToJSON 0 JSNull >>= strToText

264266-- null

265267-- >>> testJSaddle $ valToJSON 0 () >>= strToText

266−--

268+-- <BLANKLINE>

267269-- >>> testJSaddle $ valToJSON 0 True >>= strToText

268270-- true

269271-- >>> testJSaddle $ valToJSON 0 False >>= strToText

@@ -295,9 +297,9 @@ valToJSON indent value = do

295297-- May throw JSException.

296298--

297299-- >>> testJSaddle $ (valToObject JSNull >>= valToText) `catch` \ (JSException e) -> valToText e

298−-- TypeError: 'null' is not an object

300+-- TypeError: null is not an object

299301-- >>> testJSaddle $ (valToObject () >>= valToText) `catch` \ (JSException e) -> valToText e

300−-- TypeError: 'undefined' is not an object

302+-- TypeError: undefined is not an object

301303-- >>> testJSaddle $ valToObject True

302304-- true

303305-- >>> testJSaddle $ valToObject False

@@ -307,7 +309,7 @@ valToJSON indent value = do

307309-- >>> testJSaddle $ valToObject (0.0 :: Double)

308310-- 0

309311-- >>> testJSaddle $ valToObject ""

310−--

312+-- <BLANKLINE>

311313-- >>> testJSaddle $ valToObject "1"

312314-- 1

313315valToObject :: ToJSVal value => value -> JSM Object

@@ -578,23 +580,23 @@ instance ToJSString String where

578580-- | Derefernce a value reference.

579581--

580582-- >>> testJSaddle $ showJSValue <$> deRefVal JSNull

581−-- ValNull

583+-- null

582584-- >>> testJSaddle $ showJSValue <$> deRefVal ()

583−-- ValUndefined

585+-- undefined

584586-- >>> testJSaddle $ showJSValue <$> deRefVal True

585−-- ValBool True

587+-- true

586588-- >>> testJSaddle $ showJSValue <$> deRefVal False

587−-- ValBool False

589+-- false

588590-- >>> testJSaddle $ showJSValue <$> deRefVal (1.0 :: Double)

589−-- ValNumber 1.0

591+-- 1.0

590592-- >>> testJSaddle $ showJSValue <$> deRefVal (0.0 :: Double)

591−-- ValNumber 0.0

593+-- 0.0

592594-- >>> testJSaddle $ showJSValue <$> deRefVal ""

593−-- ValString ""

595+-- ""

594596-- >>> testJSaddle $ showJSValue <$> deRefVal "1"

595−-- ValString "1"

596−-- >>> testJSaddle $ showJSValue <$> valToObject True >>= deRefVal

597−-- ValObject 0x...

597+-- "1"

598+-- >>> testJSaddle $ showJSValue <$> (valToObject True >>= deRefVal)

599+-- object

598600deRefVal :: ToJSVal value => value -> JSM JSValue

599601#ifdef ghcjs_HOST_OS

600602deRefVal value = do

@@ -629,15 +631,15 @@ deRefVal value = do

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

630632--

631633-- >>> testJSaddle $ valMakeRef ValNull

632−-- "null"

634+-- null

633635-- >>> testJSaddle $ valMakeRef ValUndefined

634−-- "undefined"

636+-- undefined

635637-- >>> testJSaddle $ valMakeRef (ValBool True)

636−-- "true"

638+-- true

637639-- >>> testJSaddle $ valMakeRef (ValNumber 1)

638−-- "1"

639−-- >>> testJSaddle $ valMakeRef (ValString $ pack "Hello")

640−-- "Hello"

640+-- 1

641+-- >>> testJSaddle $ valMakeRef (ValString $ T.pack "Hello")

642+-- Hello

641643valMakeRef :: JSValue -> JSM JSVal

642644valMakeRef value =

643645 case value of

tests/DocTest.hs+22−1

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12module Main (

23 main

34) where

@@ -5,7 +6,27 @@ module Main (

56import Test.DocTest

78main :: IO ()

8−main = doctest ["-isrc",

9+main = doctest [

10+ "-idist/build/autgen",

11+ "-optP-include",

12+ "-optPdist/build/autogen/cabal_macros.h",

13+ "-hide-all-packages",

14+#ifdef VERSION_gtk3

15+ "-package=gtk3-" ++ VERSION_gtk3,

16+ "-package=webkitgtk3-" ++ VERSION_webkitgtk3,

17+ "-package=webkitgtk3-javascriptcore-" ++ VERSION_webkitgtk3_javascriptcore,

18+#else

19+ "-package=gtk-" ++ VERSION_gtk,

20+ "-package=webkit-" ++ VERSION_webkit,

21+ "-package=webkit-javascriptcore-" ++ VERSION_webkit_javascriptcore,

22+#endif

23+ "-package=glib-" ++ VERSION_glib,

24+ "-package=template-haskell-" ++ VERSION_template_haskell,

25+ "-package=base-" ++ VERSION_base,

26+ "-package=lens-" ++ VERSION_lens,

27+ "-package=text-" ++ VERSION_text,

28+ "-package=transformers-" ++ VERSION_transformers,

29+ "-isrc",

930 "src/Language/Javascript/JSaddle/Arguments.hs",

1031 "src/Language/Javascript/JSaddle/Classes.hs",

1132 "src/Language/Javascript/JSaddle/Evaluate.hs",