48d858b · jsaddle · git.iko.soy

git.iko.soy/jsaddle

Fixes for building with ghcjs

commit48d858b45108eff3e3bf7ae1d87ecbd21e631b56 authorHamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> dateSat 1 Oct 2016, 10:02 (10 years ago) parentbe56a8c

7 files changed+65−59

compare with master

unifiedsplit

jsaddle.cabal+21−20 src/Language/Javascript/JSaddle.hs+8 src/Language/Javascript/JSaddle/Evaluate.hs+3−1 src/Language/Javascript/JSaddle/Object.hs+7−12 src/Language/Javascript/JSaddle/Properties.hs+14−13 src/Language/Javascript/JSaddle/Value.hs+5−11 tests/DocTest.hs+7−2

jsaddle.cabal+21−20

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

2424 ghcjs-base -any,

2525 ghcjs-prim -any

2626 else

27+ exposed-modules:

28+ Language.Javascript.JSaddle.WebSockets

29+ Language.Javascript.JSaddle.WebSockets.Files

30+ Language.Javascript.JSaddle.Test

2731 build-depends:

2832 aeson >=1.0.0.0 && <1.1,

2933 bytestring >=0.10.8.1 && <0.11,

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

4953 Language.Javascript.JSaddle.Properties

5054 Language.Javascript.JSaddle.String

5155 Language.Javascript.JSaddle.Value

52− Language.Javascript.JSaddle.Test

5356 Language.Javascript.JSaddle.Types

54− Language.Javascript.JSaddle.WebSockets

55− Language.Javascript.JSaddle.WebSockets.Files

5657 Paths_jsaddle

5758 build-depends:

5859 base <5,

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

6768

6869test-suite test-tool

6970

70− if impl(ghcjs -any)

71− buildable: False

7271 type: exitcode-stdio-1.0

7372 main-is: DocTest.hs

7473 build-depends:

75− QuickCheck -any,

76− base -any,

77− bytestring >=0.10.8.1 && <0.11,

78− doctest -any,

79− filepath >=1.4.1.0 && <1.5,

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

81− jsaddle -any,

82− process >=1.4.2.0 && <1.5,

83− text >=0.11.2.3 && <1.3,

84− vector >=0.11.0.0 && <0.12,

85− wai >=3.2.1.1 && <3.3,

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

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

88− warp >=3.2.8 && <3.3,

89− websockets >=0.9.7.0 && <0.10

74+ base -any

75+ if !impl(ghcjs)

76+ build-depends:

77+ QuickCheck -any,

78+ bytestring >=0.10.8.1 && <0.11,

79+ doctest -any,

80+ filepath >=1.4.1.0 && <1.5,

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

82+ jsaddle -any,

83+ process >=1.4.2.0 && <1.5,

84+ text >=0.11.2.3 && <1.3,

85+ vector >=0.11.0.0 && <0.12,

86+ wai >=3.2.1.1 && <3.3,

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

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

89+ warp >=3.2.8 && <3.3,

90+ websockets >=0.9.7.0 && <0.10

9091 default-language: Haskell2010

9192 hs-source-dirs: tests

9293 ghc-options: -ferror-spans -threaded

src/Language/Javascript/JSaddle.hs+8

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

5050

5151 -- * Modules

5252 module JSaddle

53+ , run

5354) where

5455

5556import Language.Javascript.JSaddle.Types as JSaddle

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

6263import Language.Javascript.JSaddle.Object as JSaddle

6364import Language.Javascript.JSaddle.Evaluate as JSaddle

6465import 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 (

2020 eval

2121) where

2222

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

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

2424#ifdef ghcjs_HOST_OS

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

2526import GHCJS.Types (nullRef)

2627import GHCJS.Marshal.Pure (pFromJSVal)

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

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

3031 (wrapJSVal, withJSString)

3132import Language.Javascript.JSaddle.WebSockets

3233 (AsyncCommand(..), Result(..), sendLazyCommand)

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

3335#endif

3436import Language.Javascript.JSaddle.Classes

3537 (ToJSString(..))

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

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

100100import GHCJS.Foreign.Callback

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

102102import GHCJS.Marshal.Pure (pFromJSVal)

103−import JavaScript.Array (JSArray)

103+import JavaScript.Array (JSArray, MutableJSArray)

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

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

106106import qualified JavaScript.Object as Object (create)

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

557557objCallAsFunction f this args = do

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

559559 liftIO $ js_apply f this rargs

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

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

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

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

562562#else

563563objCallAsFunction f this args = do

564564 rargs <- makeArgs args

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

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

581581 liftIO $ js_new f rargs

582582foreign import javascript unsafe "\

583− try {\

584583 switch($2.length) {\

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

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

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

596595 };\

597596 temp.prototype = $1.prototype;\

598597 var i = new temp();\

599− if(ret instanceof Object)\

598+ if(ret instanceof Object) {\

600599 $r = ret;\

601− else {\

600+ } else {\

602601 i.constructor = $1;\

603602 $r = i;\

604603 }\

605− }\

606− }\

607− catch(e) {\

608− $3[0] = e;\

609− }"

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

604+ }"

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

611606#else

612607objCallAsConstructor f args = do

613608 rargs <- makeArgs args

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

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

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

4646import Language.Javascript.JSaddle.Arguments ()

4747import Language.Javascript.JSaddle.String ()

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

4849

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

5051objGetPropertyByName :: ToJSString name

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

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

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

5455#ifdef ghcjs_HOST_OS

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

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

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

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

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

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

5859#else

59−objGetPropertyByName this name = do

60− let name' = toJSString name

60+objGetPropertyByName this name =

6161 withObject this $ \rthis ->

62− withJSString name' $ sendLazyCommand . GetPropertyByName rthis

62+ withJSString (toJSString name) $

63+ sendLazyCommand . GetPropertyByName rthis

6364#endif

6465

6566-- | 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.

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

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

6970#ifdef ghcjs_HOST_OS

70−objGetPropertyAtIndex this index = liftIO . js_tryIndex index this

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

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

71+objGetPropertyAtIndex this index = liftIO $ js_tryIndex index this

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

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

7374#else

7475objGetPropertyAtIndex this index =

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

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

8586objSetPropertyByName this name val = do

8687 vref <- toJSVal val

8788 liftIO $ js_trySetProp (toJSString name) this vref

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

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

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

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

9091#else

9192objSetPropertyByName this name val = do

9293 let name' = toJSString name

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

106107objSetPropertyAtIndex this index val = do

107108 vref <- toJSVal val

108109 liftIO $ js_trySetAtIndex index this vref

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

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

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

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

111112#else

112113objSetPropertyAtIndex this index val = do

113114 gctxt <- ask

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

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

7575import Language.Javascript.JSaddle.Types

7676 (Object(..), JSString(..), JSVal(..))

7777#ifdef ghcjs_HOST_OS

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

7879import Language.Javascript.JSaddle.Types

7980 (MutableJSArray)

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

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

8283import qualified GHCJS.Marshal as GHCJS (toJSVal)

8384import GHCJS.Marshal.Pure (pToJSVal)

8485import Data.JSString.Text (textToJSString)

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

8686#else

8787import Language.Javascript.JSaddle.Native

8888 (wrapJSString, withJSVal, withObject, withJSString,

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

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

278278#ifdef ghcjs_HOST_OS

279279valToJSON 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

281281#else

282282valToJSON value =

283283 withToJSVal value $ \rval -> do

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

634634#endif

635635

636636#ifdef ghcjs_HOST_OS

637−foreign import javascript unsafe "\

638− try {\

639− $r = $1 instanceof $2\

640− }\

641− catch(e) {\

642− $3[0] = e;\

643− }"

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

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

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

645639#endif

646640

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

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

652646 v <- toJSVal value

653647 c <- makeObject constructor

654648#ifdef ghcjs_HOST_OS

655− rethrow $ return . js_isInstanceOf v c

649+ return $ js_isInstanceOf v c

656650#else

657651 withJSVal v $ \rval ->

658652 withObject c $ \c' -> do

tests/DocTest.hs+7−2

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

55 main

66) where

8+#ifndef ghcjs_HOST_OS

89import Test.DocTest

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

1011import System.Process (system)

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

1213import Control.Monad (void)

1314import Data.Monoid ((<>))

1415import Paths_jsaddle (getDataDir)

15−

16+#endif

1617

1718main :: IO ()

1819main = do

20+#ifdef ghcjs_HOST_OS

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

22+ return ()

23+#else

1924 dataDir <- getDataDir

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

2126 doctest [

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

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

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

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

55−

60+#endif