48d858b · jsaddle · git.iko.soy

jsaddle.cabal+21−20

compare with master

unifiedsplit

@@ -24,6 +24,10 @@ library

24 ghcjs-base -any,

25 ghcjs-prim -any

26 else

27+ exposed-modules:

28+ Language.Javascript.JSaddle.WebSockets

29+ Language.Javascript.JSaddle.WebSockets.Files

30+ Language.Javascript.JSaddle.Test

27 build-depends:

31 build-depends:

28 aeson >=1.0.0.0 && <1.1,

32 aeson >=1.0.0.0 && <1.1,

29 bytestring >=0.10.8.1 && <0.11,

33 bytestring >=0.10.8.1 && <0.11,

@@ -49,10 +53,7 @@ library

49 Language.Javascript.JSaddle.Properties

53 Language.Javascript.JSaddle.Properties

50 Language.Javascript.JSaddle.String

54 Language.Javascript.JSaddle.String

51 Language.Javascript.JSaddle.Value

55 Language.Javascript.JSaddle.Value

52− Language.Javascript.JSaddle.Test

53 Language.Javascript.JSaddle.Types

56 Language.Javascript.JSaddle.Types

54− Language.Javascript.JSaddle.WebSockets

55− Language.Javascript.JSaddle.WebSockets.Files

56 Paths_jsaddle

57 Paths_jsaddle

57 build-depends:

58 build-depends:

58 base <5,

59 base <5,

@@ -67,26 +68,26 @@ library

67

68

68test-suite test-tool

69test-suite test-tool

69

70

70− if impl(ghcjs -any)

71− buildable: False

72 type: exitcode-stdio-1.0

71 type: exitcode-stdio-1.0

73 main-is: DocTest.hs

72 main-is: DocTest.hs

74 build-depends:

73 build-depends:

74+ base -any

75+ if !impl(ghcjs)

76+ build-depends:

75− QuickCheck -any,

77+ QuickCheck -any,

76− base -any,

77− bytestring >=0.10.8.1 && <0.11,

78+ bytestring >=0.10.8.1 && <0.11,

78− doctest -any,

79+ doctest -any,

79− filepath >=1.4.1.0 && <1.5,

80+ filepath >=1.4.1.0 && <1.5,

80− http-types >=0.9.1 && <0.10,

81+ http-types >=0.9.1 && <0.10,

81− jsaddle -any,

82+ jsaddle -any,

82− process >=1.4.2.0 && <1.5,

83+ process >=1.4.2.0 && <1.5,

83− text >=0.11.2.3 && <1.3,

84+ text >=0.11.2.3 && <1.3,

84− vector >=0.11.0.0 && <0.12,

85+ vector >=0.11.0.0 && <0.12,

85− wai >=3.2.1.1 && <3.3,

86+ wai >=3.2.1.1 && <3.3,

86− wai-app-static >=3.1.6.1 && <3.2,

87+ wai-app-static >=3.1.6.1 && <3.2,

87− wai-websockets >=3.0.1.1 && <3.1,

88+ wai-websockets >=3.0.1.1 && <3.1,

88− warp >=3.2.8 && <3.3,

89+ warp >=3.2.8 && <3.3,

89− websockets >=0.9.7.0 && <0.10

90+ websockets >=0.9.7.0 && <0.10

90 default-language: Haskell2010

91 default-language: Haskell2010

91 hs-source-dirs: tests

92 hs-source-dirs: tests

92 ghc-options: -ferror-spans -threaded

93 ghc-options: -ferror-spans -threaded

src/Language/Javascript/JSaddle.hs+8

@@ -50,6 +50,7 @@ module Language.Javascript.JSaddle (

50

51 -- * Modules

52 module JSaddle

53+ , run

53) where

54) where

54

55

55import Language.Javascript.JSaddle.Types as JSaddle

56import Language.Javascript.JSaddle.Types as JSaddle

@@ -62,3 +63,10 @@ import Language.Javascript.JSaddle.Properties as JSaddle

62import Language.Javascript.JSaddle.Object as JSaddle

63import Language.Javascript.JSaddle.Object as JSaddle

63import Language.Javascript.JSaddle.Evaluate as JSaddle

64import Language.Javascript.JSaddle.Evaluate as JSaddle

64import Language.Javascript.JSaddle.String as JSaddle

65import Language.Javascript.JSaddle.String as JSaddle

66+#ifdef ghcjs_HOST_OS

67+import Control.Monad.Trans.Reader (ReaderT(..))

68+run :: Int -> JSM () -> IO ()

69+run _port = (`runReaderT` ())

70+#else

71+import Language.Javascript.JSaddle.WebSockets (run)

72+#endif

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

@@ -20,8 +20,9 @@ module Language.Javascript.JSaddle.Evaluate (

20 eval

21) where

22

23−import Language.Javascript.JSaddle.Types (Result(..), JSVal)

23+import Language.Javascript.JSaddle.Types (JSVal)

24#ifdef ghcjs_HOST_OS

25+import Control.Monad.IO.Class (MonadIO(..))

25import GHCJS.Types (nullRef)

26import GHCJS.Types (nullRef)

26import GHCJS.Marshal.Pure (pFromJSVal)

27import GHCJS.Marshal.Pure (pFromJSVal)

27import Language.Javascript.JSaddle.Types (JSString)

28import Language.Javascript.JSaddle.Types (JSString)

@@ -30,6 +31,7 @@ import Language.Javascript.JSaddle.Native

30 (wrapJSVal, withJSString)

31 (wrapJSVal, withJSString)

31import Language.Javascript.JSaddle.WebSockets

32import Language.Javascript.JSaddle.WebSockets

32 (AsyncCommand(..), Result(..), sendLazyCommand)

33 (AsyncCommand(..), Result(..), sendLazyCommand)

34+import Language.Javascript.JSaddle.Types (Result(..))

33#endif

35#endif

34import Language.Javascript.JSaddle.Classes

36import Language.Javascript.JSaddle.Classes

35 (ToJSString(..))

37 (ToJSString(..))

src/Language/Javascript/JSaddle/Object.hs+7−12

@@ -100,7 +100,7 @@ import GHCJS.Types (nullRef, jsval)

100import GHCJS.Foreign.Callback

101 (releaseCallback, syncCallback2, OnBlocked(..), Callback)

102import GHCJS.Marshal.Pure (pFromJSVal)

103−import JavaScript.Array (JSArray)

103+import JavaScript.Array (JSArray, MutableJSArray)

104import qualified JavaScript.Array as Array (toListIO, fromListIO)

105import JavaScript.Array.Internal (SomeJSArray(..))

106import qualified JavaScript.Object as Object (create)

@@ -557,8 +557,8 @@ objCallAsFunction :: MakeArgs args

557objCallAsFunction f this args = do

558 rargs <- makeArgs args >>= liftIO . Array.fromListIO

559 liftIO $ js_apply f this rargs

560−foreign import javascript unsafe "try { $r = $1.apply($2, $3) } catch(e) { $4[0] = e }"

560+foreign import javascript unsafe "$r = $1.apply($2, $3)"

561− js_apply :: Object -> Object -> MutableJSArray -> MutableJSArray -> IO JSVal

561+ js_apply :: Object -> Object -> MutableJSArray -> IO JSVal

562#else

563objCallAsFunction f this args = do

564 rargs <- makeArgs args

@@ -580,7 +580,6 @@ objCallAsConstructor f args = do

580 rargs <- makeArgs args >>= liftIO . Array.fromListIO

581 liftIO $ js_new f rargs

582foreign import javascript unsafe "\

583− try {\

584 switch($2.length) {\

583 switch($2.length) {\

585 case 0 : $r = new $1(); break;\

584 case 0 : $r = new $1(); break;\

586 case 1 : $r = new $1($2[0]); break;\

585 case 1 : $r = new $1($2[0]); break;\

@@ -596,18 +595,14 @@ foreign import javascript unsafe "\

596 };\

595 };\

597 temp.prototype = $1.prototype;\

596 temp.prototype = $1.prototype;\

598 var i = new temp();\

597 var i = new temp();\

599− if(ret instanceof Object)\

598+ if(ret instanceof Object) {\

600 $r = ret;\

599 $r = ret;\

601− else {\

600+ } else {\

602 i.constructor = $1;\

601 i.constructor = $1;\

603 $r = i;\

602 $r = i;\

604 }\

603 }\

605− }\

604+ }"

606− }\

607− catch(e) {\

608− $3[0] = e;\

609− }"

610− js_new :: Object -> MutableJSArray -> MutableJSArray -> IO JSVal

605+ js_new :: Object -> MutableJSArray -> IO JSVal

611#else

606#else

612objCallAsConstructor f args = do

607objCallAsConstructor f args = do

613 rargs <- makeArgs args

608 rargs <- makeArgs args

src/Language/Javascript/JSaddle/Properties.hs+14−13

@@ -45,6 +45,7 @@ import Control.Monad.Trans.Reader (ask)

45import Language.Javascript.JSaddle.Value (JSVal)

46import Language.Javascript.JSaddle.Arguments ()

47import Language.Javascript.JSaddle.String ()

48+import Control.Monad.IO.Class (MonadIO(..))

48

49

49-- | Get a property value given the object and the name of the property.

50-- | Get a property value given the object and the name of the property.

50objGetPropertyByName :: ToJSString name

51objGetPropertyByName :: ToJSString name

@@ -52,14 +53,14 @@ objGetPropertyByName :: ToJSString name

52 -> name -- ^ name of the property.

53 -> name -- ^ name of the property.

53 -> JSM JSVal -- ^ returns the property value.

54 -> JSM JSVal -- ^ returns the property value.

54#ifdef ghcjs_HOST_OS

55#ifdef ghcjs_HOST_OS

55−objGetPropertyByName this name = liftIO . js_tryGetProp (toJSString name) this

56+objGetPropertyByName this name = liftIO $ js_tryGetProp (toJSString name) this

56−foreign import javascript unsafe "try { $r=$2[$1] } catch(e) { $3[0] = e }"

57+foreign import javascript unsafe "$r=$2[$1]"

57− js_tryGetProp :: JSString -> Object -> MutableJSArray -> IO JSVal

58+ js_tryGetProp :: JSString -> Object -> IO JSVal

58#else

59#else

59−objGetPropertyByName this name = do

60+objGetPropertyByName this name =

60− let name' = toJSString name

61 withObject this $ \rthis ->

62+ withJSString (toJSString name) $

62− withJSString name' $ sendLazyCommand . GetPropertyByName rthis

63+ sendLazyCommand . GetPropertyByName rthis

63#endif

64#endif

64

65

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

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

@@ -67,9 +68,9 @@ objGetPropertyAtIndex :: Object -- ^ object to find the property on.

67 -> Index -- ^ index of the property.

68 -> Index -- ^ index of the property.

68 -> JSM JSVal -- ^ returns the property value.

69 -> JSM JSVal -- ^ returns the property value.

69#ifdef ghcjs_HOST_OS

70#ifdef ghcjs_HOST_OS

70−objGetPropertyAtIndex this index = liftIO . js_tryIndex index this

71+objGetPropertyAtIndex this index = liftIO $ js_tryIndex index this

71−foreign import javascript unsafe "try { $r=$2[$1] } catch(e) { $3[0] = e }"

72+foreign import javascript unsafe "$r=$2[$1]"

72− js_tryIndex :: Index -> Object -> MutableJSArray -> IO JSVal

73+ js_tryIndex :: Index -> Object -> IO JSVal

73#else

74#else

74objGetPropertyAtIndex this index =

75objGetPropertyAtIndex this index =

75 withObject this $ \rthis -> sendLazyCommand $ GetPropertyAtIndex rthis index

76 withObject this $ \rthis -> sendLazyCommand $ GetPropertyAtIndex rthis index

@@ -85,8 +86,8 @@ objSetPropertyByName :: (ToJSString name, ToJSVal val)

85objSetPropertyByName this name val = do

86objSetPropertyByName this name val = do

86 vref <- toJSVal val

87 vref <- toJSVal val

87 liftIO $ js_trySetProp (toJSString name) this vref

88 liftIO $ js_trySetProp (toJSString name) this vref

88−foreign import javascript unsafe "try { $2[$1]=$3 } catch(e) { $4[0] = e }"

89+foreign import javascript unsafe "$2[$1]=$3"

89− js_trySetProp :: JSString -> Object -> JSVal -> MutableJSArray -> IO ()

90+ js_trySetProp :: JSString -> Object -> JSVal -> IO ()

90#else

91#else

91objSetPropertyByName this name val = do

92objSetPropertyByName this name val = do

92 let name' = toJSString name

93 let name' = toJSString name

@@ -106,8 +107,8 @@ objSetPropertyAtIndex :: (ToJSVal val)

106objSetPropertyAtIndex this index val = do

107objSetPropertyAtIndex this index val = do

107 vref <- toJSVal val

108 vref <- toJSVal val

108 liftIO $ js_trySetAtIndex index this vref

109 liftIO $ js_trySetAtIndex index this vref

109−foreign import javascript unsafe "try { $2[$1]=$3 } catch(e) { $4[0] = e }"

110+foreign import javascript unsafe "$2[$1]=$3"

110− js_trySetAtIndex :: Index -> Object -> JSVal -> MutableJSArray -> IO ()

111+ js_trySetAtIndex :: Index -> Object -> JSVal -> IO ()

111#else

112#else

112objSetPropertyAtIndex this index val = do

113objSetPropertyAtIndex this index val = do

113 gctxt <- ask

114 gctxt <- ask

src/Language/Javascript/JSaddle/Value.hs+5−11

@@ -75,6 +75,7 @@ import Prelude hiding (catch)

75import Language.Javascript.JSaddle.Types

76 (Object(..), JSString(..), JSVal(..))

77#ifdef ghcjs_HOST_OS

78+import Control.Monad.IO.Class (MonadIO(..))

78import Language.Javascript.JSaddle.Types

79import Language.Javascript.JSaddle.Types

79 (MutableJSArray)

80 (MutableJSArray)

80import GHCJS.Types (JSVal(..), isNull, isUndefined)

81import GHCJS.Types (JSVal(..), isNull, isUndefined)

@@ -82,7 +83,6 @@ import GHCJS.Foreign (toJSBool, isTruthy, jsNull, jsUndefined)

82import qualified GHCJS.Marshal as GHCJS (toJSVal)

83import qualified GHCJS.Marshal as GHCJS (toJSVal)

83import GHCJS.Marshal.Pure (pToJSVal)

84import GHCJS.Marshal.Pure (pToJSVal)

84import Data.JSString.Text (textToJSString)

85import Data.JSString.Text (textToJSString)

85−import Language.Javascript.JSaddle.Exception (rethrow)

86#else

87import Language.Javascript.JSaddle.Native

88 (wrapJSString, withJSVal, withObject, withJSString,

@@ -277,7 +277,7 @@ valToText jsvar = strToText <$> valToStr jsvar

277valToJSON :: ToJSVal value => value -> JSM JSString

278#ifdef ghcjs_HOST_OS

279valToJSON value = jsrefToJSON <$> toJSVal value

280−foreign import javascript unsafe "$r = $1 === undefined ? "" : JSON.stringify($1);" jsrefToJSON :: JSVal -> JSString

280+foreign import javascript unsafe "$r = $1 === undefined ? \"\" : JSON.stringify($1);" jsrefToJSON :: JSVal -> JSString

281#else

282valToJSON value =

283 withToJSVal value $ \rval -> do

@@ -634,14 +634,8 @@ strictEqual a b = do

634#endif

635

636#ifdef ghcjs_HOST_OS

637−foreign import javascript unsafe "\

637+foreign import javascript unsafe "$1 instanceof $2"

638− try {\

639− $r = $1 instanceof $2\

640− }\

641− catch(e) {\

642− $3[0] = e;\

643− }"

644− js_isInstanceOf :: JSVal -> Object -> MutableJSArray -> Bool

638+ js_isInstanceOf :: JSVal -> Object -> Bool

645#endif

639#endif

646

640

647-- | Determine if two values are equal (JavaScripts ===)

641-- | Determine if two values are equal (JavaScripts ===)

@@ -652,7 +646,7 @@ instanceOf value constructor = do

652 v <- toJSVal value

646 v <- toJSVal value

653 c <- makeObject constructor

647 c <- makeObject constructor

654#ifdef ghcjs_HOST_OS

648#ifdef ghcjs_HOST_OS

655− rethrow $ return . js_isInstanceOf v c

649+ return $ js_isInstanceOf v c

656#else

650#else

657 withJSVal v $ \rval ->

651 withJSVal v $ \rval ->

658 withObject c $ \c' -> do

652 withObject c $ \c' -> do

tests/DocTest.hs+7−2

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

5 main

6) where

7

8+#ifndef ghcjs_HOST_OS

8import Test.DocTest

9import Test.DocTest

9import System.FilePath ((</>))

10import System.FilePath ((</>))

10import System.Process (system)

11import System.Process (system)

@@ -12,10 +13,14 @@ import Control.Concurrent (forkIO)

12import Control.Monad (void)

13import Control.Monad (void)

13import Data.Monoid ((<>))

14import Data.Monoid ((<>))

14import Paths_jsaddle (getDataDir)

15import Paths_jsaddle (getDataDir)

15−

16+#endif

16

17

17main :: IO ()

18main :: IO ()

18main = do

19main = do

20+#ifdef ghcjs_HOST_OS

21+ putStrLn "TODO find a way to run doctest tests with GHCJS"

22+ return ()

23+#else

19 dataDir <- getDataDir

24 dataDir <- getDataDir

20 forkIO . void . system $ "node --harmony " <> dataDir </> "data/jsaddle.js"

25 forkIO . void . system $ "node --harmony " <> dataDir </> "data/jsaddle.js"

21 doctest [

26 doctest [

@@ -52,4 +57,4 @@ main = do

52 "src/Language/Javascript/JSaddle/Test.hs",

57 "src/Language/Javascript/JSaddle/Test.hs",

53 "src/Language/Javascript/JSaddle/Types.hs",

58 "src/Language/Javascript/JSaddle/Types.hs",

54 "src/Language/Javascript/JSaddle/Value.hs" ]

59 "src/Language/Javascript/JSaddle/Value.hs" ]

55−

60+#endif