jsaddle 0.6.0.1 → 0.7.0.0

raw patch · 23 files changed

+1269/−276 lines, 23 filesdep +attoparsecdep +deepseqdep +ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec, deepseq, ghc-prim, scientific, unordered-containers, vector

API changes (from Hackage documentation)

Files

• jsaddle.cabal +22/−4
• src-ghc/GHCJS/Marshal.hs +168/−0
• src-ghc/GHCJS/Marshal/Internal.hs +248/−0
• src-ghc/GHCJS/Marshal/Pure.hs +20/−0
• src-ghc/JavaScript/Array/Internal.hs +46/−0
• src-ghc/JavaScript/Object/Internal.hs +49/−0
• src/Language/Javascript/JSaddle.hs +3/−1
• src/Language/Javascript/JSaddle/Arguments.hs +3/−13
• src/Language/Javascript/JSaddle/Array.hs +121/−0
• src/Language/Javascript/JSaddle/Classes.hs +15/−23
• src/Language/Javascript/JSaddle/Classes/Internal.hs +41/−0
• src/Language/Javascript/JSaddle/Evaluate.hs +2/−3
• src/Language/Javascript/JSaddle/Foreign.hs +99/−0
• src/Language/Javascript/JSaddle/Marshal/String.hs +32/−0
• src/Language/Javascript/JSaddle/Native.hs +3/−47
• src/Language/Javascript/JSaddle/Native/Internal.hs +64/−0
• src/Language/Javascript/JSaddle/Object.hs +25/−64
• src/Language/Javascript/JSaddle/Properties.hs +11/−29
• src/Language/Javascript/JSaddle/Run.hs +1/−1
• src/Language/Javascript/JSaddle/Run/Files.hs +75/−0
• src/Language/Javascript/JSaddle/String.hs +10/−11
• src/Language/Javascript/JSaddle/Types.hs +51/−4
• src/Language/Javascript/JSaddle/Value.hs +160/−76

@@ -1,5 +1,5 @@ name: jsaddle-version: 0.6.0.1+version: 0.7.0.0 cabal-version: >=1.10 build-type: Simple license: MIT@@ -26,22 +26,39 @@             ghcjs-prim -any     else         build-depends:-            aeson >=0.8.0.2 && <1.1,+            attoparsec >=0.11 && <0.14,             containers >=0.5.6.2 && <0.6,+            deepseq >=1.3 && < 1.5,             filepath >=1.4.0.0 && <1.5,+            ghc-prim,             http-types >=0.8.6 && <0.10,             process >=1.2.3.0 && <1.5,             ref-tf >=0.4.0.1 && <0.5,+            scientific >=0.3 && <0.4,             stm >=2.4.4 && <2.5,-            time >=1.5.0.1 && <1.7+            time >=1.5.0.1 && <1.7,+            unordered-containers >=0.2 && <0.3,+            vector >=0.10 && <0.12+        exposed-modules:+            GHCJS.Marshal+            GHCJS.Marshal.Internal+            GHCJS.Marshal.Pure+            JavaScript.Array.Internal+            JavaScript.Object.Internal+            Language.Javascript.JSaddle.Native+            Language.Javascript.JSaddle.Native.Internal+        hs-source-dirs: src-ghc     exposed-modules:         Language.Javascript.JSaddle+        Language.Javascript.JSaddle.Array         Language.Javascript.JSaddle.Arguments         Language.Javascript.JSaddle.Classes+        Language.Javascript.JSaddle.Classes.Internal         Language.Javascript.JSaddle.Evaluate         Language.Javascript.JSaddle.Exception+        Language.Javascript.JSaddle.Foreign+        Language.Javascript.JSaddle.Marshal.String         Language.Javascript.JSaddle.Monad-        Language.Javascript.JSaddle.Native         Language.Javascript.JSaddle.Object         Language.Javascript.JSaddle.Properties         Language.Javascript.JSaddle.Run@@ -50,6 +67,7 @@         Language.Javascript.JSaddle.Value         Language.Javascript.JSaddle.Types     build-depends:+        aeson >=0.8.0.2 && <1.1,         base <5,         bytestring >=0.10.6.0 && <0.11,         lens >=3.8.5 && <4.16,

@@ -0,0 +1,168 @@+{-# LANGUAGE ScopedTypeVariables,+             FlexibleContexts,+             FlexibleInstances,+             OverloadedStrings,+             TupleSections,+             LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module GHCJS.Marshal ( FromJSVal(..)+                     , ToJSVal(..)+                     , toJSVal_aeson+                     , toJSVal_pure+                     ) where++import           Control.Monad (join)+import           Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)++import qualified Data.Aeson as AE+import           Data.Int (Int8, Int16, Int32)+import           Data.Word (Word8, Word16, Word32, Word)++import           GHC.Prim++import           Language.Javascript.JSaddle.Types (JSM, JSVal, SomeJSArray(..), Command(ValueToJSONValue), Result(ValueToJSONValueResult))+import           Language.Javascript.JSaddle.Native (withToJSVal)+import           Language.Javascript.JSaddle.Run(sendCommand)+import           GHCJS.Marshal.Internal+import           GHCJS.Marshal.Pure ()+import           Language.Javascript.JSaddle.Value (isUndefinedIO, valToNumber,+                                                    valToBool, valMakeJSON)+import           Language.Javascript.JSaddle.Array (fromListIO)+import qualified Language.Javascript.JSaddle.Array as A (read)++instance FromJSVal JSVal where+  fromJSValUnchecked x = return x+  {-# INLINE fromJSValUnchecked #-}+  fromJSVal = return . Just+  {-# INLINE fromJSVal #-}+instance FromJSVal () where+  fromJSValUnchecked = fromJSValUnchecked_pure+  {-# INLINE fromJSValUnchecked #-}+  fromJSVal = fromJSVal_pure+--    {-# INLINE fromJSVal #-}+instance FromJSVal Bool where+    fromJSValUnchecked = valToBool+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap Just . valToBool+    {-# INLINE fromJSVal #-}+instance FromJSVal Int where+    fromJSValUnchecked = fmap round . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . round) . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal Int8 where+    fromJSValUnchecked = fmap round . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . round) . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal Int16 where+    fromJSValUnchecked = fmap round . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . round) . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal Int32 where+    fromJSValUnchecked = fmap round . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . round) . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal Word where+    fromJSValUnchecked = fmap round . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . round) . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal Word8 where+    fromJSValUnchecked = fmap round . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . round) . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal Word16 where+    fromJSValUnchecked = fmap round . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . round) . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal Word32 where+    fromJSValUnchecked = fmap round . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . round) . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal Float where+    fromJSValUnchecked = fmap realToFrac . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . realToFrac) . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal Double where+    fromJSValUnchecked = valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap Just . valToNumber+    {-# INLINE fromJSVal #-}+instance FromJSVal AE.Value where+    fromJSVal r =+        withToJSVal r $ \rval -> do+            ValueToJSONValueResult result <- sendCommand (ValueToJSONValue rval)+            return $ Just result+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b) => FromJSVal (a,b) where+    fromJSVal r = runMaybeT $ (,) <$> jf r 0 <*> jf r 1+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c) => FromJSVal (a,b,c) where+    fromJSVal r = runMaybeT $ (,,) <$> jf r 0 <*> jf r 1 <*> jf r 2+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d) => FromJSVal (a,b,c,d) where+    fromJSVal r = runMaybeT $ (,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e) => FromJSVal (a,b,c,d,e) where+    fromJSVal r = runMaybeT $ (,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e, FromJSVal f) => FromJSVal (a,b,c,d,e,f) where+    fromJSVal r = runMaybeT $ (,,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4 <*> jf r 5+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e, FromJSVal f, FromJSVal g) => FromJSVal (a,b,c,d,e,f,g) where+    fromJSVal r = runMaybeT $ (,,,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4 <*> jf r 5 <*> jf r 6+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e, FromJSVal f, FromJSVal g, FromJSVal h) => FromJSVal (a,b,c,d,e,f,g,h) where+    fromJSVal r = runMaybeT $ (,,,,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4 <*> jf r 5 <*> jf r 6 <*> jf r 7+    {-# INLINE fromJSVal #-}++jf :: FromJSVal a => JSVal -> Int -> MaybeT JSM a+jf r n = MaybeT $ do+  r' <- A.read n (SomeJSArray r)+  isUndefinedIO r >>= \case+    True -> return Nothing+    False -> fromJSVal r'++instance (ToJSVal a, ToJSVal b) => ToJSVal (a,b) where+    toJSVal (a,b) = join $ arr2 <$> toJSVal a <*> toJSVal b+    {-# INLINE toJSVal #-}+instance (ToJSVal a, ToJSVal b, ToJSVal c) => ToJSVal (a,b,c) where+    toJSVal (a,b,c) = join $ arr3 <$> toJSVal a <*> toJSVal b <*> toJSVal c+    {-# INLINE toJSVal #-}+instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d) => ToJSVal (a,b,c,d) where+    toJSVal (a,b,c,d) = join $ arr4 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d+    {-# INLINE toJSVal #-}+instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e) => ToJSVal (a,b,c,d,e) where+    toJSVal (a,b,c,d,e) = join $ arr5 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d <*> toJSVal e+    {-# INLINE toJSVal #-}+instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e, ToJSVal f) => ToJSVal (a,b,c,d,e,f) where+    toJSVal (a,b,c,d,e,f) = join $ arr6 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d <*> toJSVal e <*> toJSVal f+    {-# INLINE toJSVal #-}+instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e, ToJSVal f, ToJSVal g) => ToJSVal (a,b,c,d,e,f,g) where+    toJSVal (a,b,c,d,e,f,g) = join $ arr7 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d <*> toJSVal e <*> toJSVal f <*> toJSVal g+    {-# INLINE toJSVal #-}++arr2 :: JSVal -> JSVal -> JSM JSVal+arr2 a b           = coerce <$> fromListIO [a,b]+arr3 :: JSVal -> JSVal -> JSVal -> JSM JSVal+arr3 a b c         = coerce <$> fromListIO [a,b,c]+arr4 :: JSVal -> JSVal -> JSVal -> JSVal -> JSM JSVal+arr4 a b c d       = coerce <$> fromListIO [a,b,c,d]+arr5 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSM JSVal+arr5 a b c d e     = coerce <$> fromListIO [a,b,c,d,e]+arr6 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSM JSVal+arr6 a b c d e f   = coerce <$> fromListIO [a,b,c,d,e,f]+arr7 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSM JSVal+arr7 a b c d e f g = coerce <$> fromListIO [a,b,c,d,e,f,g]++toJSVal_aeson :: AE.ToJSON a => a -> JSM JSVal+toJSVal_aeson = valMakeJSON . AE.toJSON+

@@ -0,0 +1,248 @@+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, DefaultSignatures,+             TypeOperators, TupleSections, FlexibleContexts, FlexibleInstances,+             LambdaCase+  #-}++module GHCJS.Marshal.Internal (+        FromJSVal(..)+      , ToJSVal(..)+      , PToJSVal(..)+      , PFromJSVal(..)+      , Purity(..)+      , toJSVal_generic+      , fromJSVal_generic+      , toJSVal_pure+      , fromJSVal_pure+      , fromJSValUnchecked_pure+      ) where++import           Control.Monad++import           Data.Data+import           Data.Maybe+import           Data.Coerce (coerce)+import qualified Data.Text as T (pack)++import           GHC.Generics++import           Language.Javascript.JSaddle.Types (JSM, JSVal, SomeJSArray(..), MutableJSArray, JSString)+import           Language.Javascript.JSaddle.Foreign (jsNull, jsTrue, isUndefinedIO)+import           Language.Javascript.JSaddle.String (textToStr)+import qualified JavaScript.Object.Internal as OI (Object(..), create, setProp, getProp)+import qualified JavaScript.Array.Internal as AI (create, push, read, fromListIO, toListIO)++data Purity = PureShared    -- ^ conversion is pure even if the original value is shared+            | PureExclusive -- ^ conversion is pure if the we only convert once+  deriving (Eq, Ord, Typeable, Data)++class PToJSVal a where+--  type PureOut a :: Purity+  pToJSVal :: a -> JSVal++class PFromJSVal a where+--  type PureIn a :: Purity+  pFromJSVal :: JSVal -> a++class ToJSVal a where+  toJSVal :: a -> JSM JSVal++  toJSValListOf :: [a] -> JSM JSVal+  toJSValListOf = fmap coerce . AI.fromListIO <=< mapM toJSVal++  default toJSVal :: (Generic a, GToJSVal (Rep a ())) => a -> JSM JSVal+  toJSVal = toJSVal_generic id++class FromJSVal a where+  fromJSVal :: JSVal -> JSM (Maybe a)++  fromJSValUnchecked :: JSVal -> JSM a+  fromJSValUnchecked = fmap fromJust . fromJSVal+  {-# INLINE fromJSValUnchecked #-}++  fromJSValListOf :: JSVal -> JSM (Maybe [a])+  fromJSValListOf = fmap sequence . (mapM fromJSVal <=< AI.toListIO . coerce) -- fixme should check that it's an array++  fromJSValUncheckedListOf :: JSVal -> JSM [a]+  fromJSValUncheckedListOf = mapM fromJSValUnchecked <=< AI.toListIO . coerce++  default fromJSVal :: (Generic a, GFromJSVal (Rep a ())) => JSVal -> JSM (Maybe a)+  fromJSVal = fromJSVal_generic id++-- -----------------------------------------------------------------------------++class GToJSVal a where+  gToJSVal :: (String -> String) -> Bool -> a -> JSM JSVal++class GToJSProp a where+  gToJSProp :: (String -> String) -> JSVal -> a -> JSM ()++class GToJSArr a where+  gToJSArr :: (String -> String) -> MutableJSArray -> a -> JSM ()++instance (ToJSVal b) => GToJSVal (K1 a b c) where+  gToJSVal _ _ (K1 x) = toJSVal x++instance GToJSVal p => GToJSVal (Par1 p) where+  gToJSVal f b (Par1 p) = gToJSVal f b p++instance GToJSVal (f p) => GToJSVal (Rec1 f p) where+  gToJSVal f b (Rec1 x) = gToJSVal f b x++instance (GToJSVal (a p), GToJSVal (b p)) => GToJSVal ((a :+: b) p) where+  gToJSVal f _ (L1 x) = gToJSVal f True x+  gToJSVal f _ (R1 x) = gToJSVal f True x++instance (GToJSVal (a p)) => GToJSVal (M1 D c a p) where+  gToJSVal f b (M1 x) = gToJSVal f b x++instance (Constructor c, GToJSVal (a p)) => GToJSVal (M1 C c a p) where+  gToJSVal f True m@(M1 x) = do+    obj@(OI.Object obj') <- OI.create+    v   <- gToJSVal f (conIsRecord m) x+    OI.setProp (packJSS . f $ conName m) v obj+    return obj'+  gToJSVal f _ m@(M1 x) = gToJSVal f (conIsRecord m) x++instance (GToJSArr (a p), GToJSArr (b p), GToJSProp (a p), GToJSProp (b p)) => GToJSVal ((a :*: b) p) where+  gToJSVal f True xy = do+    (OI.Object obj') <- OI.create+    gToJSProp f obj' xy+    return obj'+  gToJSVal f False xy = do+    arr@(SomeJSArray arr') <- AI.create+    gToJSArr f arr xy+    return arr'++instance GToJSVal (a p) => GToJSVal (M1 S c a p) where+  gToJSVal f b (M1 x) = gToJSVal f b x++instance (GToJSProp (a p), GToJSProp (b p)) => GToJSProp ((a :*: b) p) where+  gToJSProp f o (x :*: y) = gToJSProp f o x >> gToJSProp f o y++instance (Selector c, GToJSVal (a p)) => GToJSProp (M1 S c a p) where+  gToJSProp f o m@(M1 x) = do+    r <- gToJSVal f False x+    OI.setProp (packJSS . f $ selName m) r (OI.Object o)++instance (GToJSArr (a p), GToJSArr (b p)) => GToJSArr ((a :*: b) p) where+  gToJSArr f a (x :*: y) = gToJSArr f a x >> gToJSArr f a y++instance GToJSVal (a p) => GToJSArr (M1 S c a p) where+  gToJSArr f a (M1 x) = do+    r <- gToJSVal f False x+    AI.push r a++instance GToJSVal (V1 p) where+  gToJSVal _ _ _ = return jsNull++instance GToJSVal (U1 p) where+  gToJSVal _ _ _ = return jsTrue++toJSVal_generic :: forall a . (Generic a, GToJSVal (Rep a ()))+                => (String -> String) -> a -> JSM JSVal+toJSVal_generic f x = gToJSVal f False (from x :: Rep a ())++-- -----------------------------------------------------------------------------++class GFromJSVal a where+  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe a)++class GFromJSProp a where+  gFromJSProp :: (String -> String) -> JSVal -> JSM (Maybe a)++class GFromJSArr a where+  gFromJSArr :: (String -> String) -> MutableJSArray -> Int -> JSM (Maybe (a,Int))++instance FromJSVal b => GFromJSVal (K1 a b c) where+  gFromJSVal _ _ r = fmap K1 <$> fromJSVal r++instance GFromJSVal p => GFromJSVal (Par1 p) where+  gFromJSVal f b r = gFromJSVal f b r++instance GFromJSVal (f p) => GFromJSVal (Rec1 f p) where+  gFromJSVal f b r = gFromJSVal f b r++instance (GFromJSVal (a p), GFromJSVal (b p)) => GFromJSVal ((a :+: b) p) where+  gFromJSVal f _b r = do+    l <- gFromJSVal f True r+    case l of+      Just x  -> return (L1 <$> Just x)+      Nothing -> fmap R1 <$> gFromJSVal f True r++instance GFromJSVal (a p) => GFromJSVal (M1 D c a p) where+  gFromJSVal f b r = fmap M1 <$> gFromJSVal f b r++instance forall c a p . (Constructor c, GFromJSVal (a p)) => GFromJSVal (M1 C c a p) where+  gFromJSVal f True r = do+    r' <- OI.getProp (packJSS . f $ conName (undefined :: M1 C c a p)) (OI.Object r)+    isUndefinedIO r' >>= \case+      True -> return Nothing+      False -> fmap M1 <$> gFromJSVal f (conIsRecord (undefined :: M1 C c a p)) r'+  gFromJSVal f _ r = fmap M1 <$> gFromJSVal f (conIsRecord (undefined :: M1 C c a p)) r++instance (GFromJSArr (a p), GFromJSArr (b p), GFromJSProp (a p), GFromJSProp (b p)) => GFromJSVal ((a :*: b) p) where+  gFromJSVal f True  r = gFromJSProp f r+  gFromJSVal f False r = fmap fst <$> gFromJSArr f (SomeJSArray r) 0++instance GFromJSVal (a p) => GFromJSVal (M1 S c a p) where+  gFromJSVal f b r = fmap M1 <$> gFromJSVal f b r++instance (GFromJSProp (a p), GFromJSProp (b p)) => GFromJSProp ((a :*: b) p) where+  gFromJSProp f r = do+    a <- gFromJSProp f r+    case a of+      Nothing -> return Nothing+      Just a' -> fmap (a':*:) <$> gFromJSProp f r++instance forall c a p . (Selector c, GFromJSVal (a p)) => GFromJSProp (M1 S c a p) where+  gFromJSProp f o = do+    p <- OI.getProp (packJSS . f $ selName (undefined :: M1 S c a p)) (OI.Object o)+    isUndefinedIO p >>= \case+      True -> return Nothing+      False -> fmap M1 <$> gFromJSVal f False p++instance (GFromJSArr (a p), GFromJSArr (b p)) => GFromJSArr ((a :*: b) p) where+  gFromJSArr f r _n = do+    a <- gFromJSArr f r 0+    case a of+      Just (a',an) -> do+        b <- gFromJSArr f r an+        case b of+          Just (b',bn) -> return (Just (a' :*: b',bn))+          _            -> return Nothing++instance (GFromJSVal (a p)) => GFromJSArr (M1 S c a p) where+  gFromJSArr f o n = do+    r <- AI.read n o+    isUndefinedIO r >>= \case+      True -> return Nothing+      False -> fmap ((,n+1) . M1) <$> gFromJSVal f False r++instance GFromJSVal (V1 p) where+  gFromJSVal _ _ _ = return Nothing++instance GFromJSVal (U1 p) where+  gFromJSVal _ _ _ = return (Just U1)++fromJSVal_generic :: forall a . (Generic a, GFromJSVal (Rep a ()))+                => (String -> String) -> JSVal -> JSM (Maybe a)+fromJSVal_generic f x = fmap to <$> (gFromJSVal f False x :: JSM (Maybe (Rep a ())))++-- -----------------------------------------------------------------------------++fromJSVal_pure :: PFromJSVal a => JSVal -> JSM (Maybe a)+fromJSVal_pure x = return (Just (pFromJSVal x))+{-# INLINE fromJSVal_pure #-}++fromJSValUnchecked_pure :: PFromJSVal a => JSVal -> JSM a+fromJSValUnchecked_pure x = return (pFromJSVal x)+{-# INLINE fromJSValUnchecked_pure #-}++toJSVal_pure :: PToJSVal a => a -> JSM JSVal+toJSVal_pure x = return (pToJSVal x)+{-# INLINE toJSVal_pure #-}++-- -----------------------------------------------------------------------------++packJSS :: String -> JSString+packJSS = textToStr . T.pack

@@ -0,0 +1,20 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module GHCJS.Marshal.Pure+  ( PFromJSVal(..)+  , PToJSVal(..)+  ) where++import           GHCJS.Marshal.Internal+import           Language.Javascript.JSaddle.Types (JSVal(..))+import           Language.Javascript.JSaddle.Foreign (jsFalse, jsTrue)++instance PFromJSVal JSVal where pFromJSVal = id+                                {-# INLINE pFromJSVal #-}+instance PFromJSVal ()    where pFromJSVal _ = ()+                                {-# INLINE pFromJSVal #-}++instance PToJSVal JSVal     where pToJSVal = id+                                  {-# INLINE pToJSVal #-}+instance PToJSVal Bool      where pToJSVal True     = jsTrue+                                  pToJSVal False    = jsFalse+                                  {-# INLINE pToJSVal #-}

@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}+module JavaScript.Array.Internal+    ( create+    , fromListIO+    , toListIO+    , read+    , push+    ) where++import Prelude hiding(read)+import Control.Monad (void)+import Language.Javascript.JSaddle.Types (JSM, JSVal, SomeJSArray(..), MutableJSArray, Object(..), JSString(..))+import Language.Javascript.JSaddle.Native.Internal+       (withObject, withJSVal, withJSString, withJSVals)+import Language.Javascript.JSaddle.Run+       (Command(..), Result(..), AsyncCommand(..), sendCommand, sendLazyCommand)++create :: JSM MutableJSArray+create = SomeJSArray <$> sendLazyCommand (NewArray [])+{-# INLINE create #-}++fromListIO :: [JSVal] -> JSM (SomeJSArray m)+fromListIO xs = withJSVals xs $ \xs' -> SomeJSArray <$> sendLazyCommand (NewArray xs')+{-# INLINE fromListIO #-}++toListIO :: SomeJSArray m -> JSM [JSVal]+toListIO (SomeJSArray x) =+    withObject (Object x) $ \this -> do+        l <- withJSString (JSString "length") $ sendLazyCommand . GetPropertyByName this+        withJSVal l $ \l' -> do+            ValueToNumberResult len <- sendCommand (ValueToNumber l')+            mapM (sendLazyCommand . GetPropertyAtIndex this) [0..round len - 1]+{-# INLINE toListIO #-}++read :: Int -> SomeJSArray m -> JSM JSVal+read n (SomeJSArray x) =+    withObject (Object x) $ \this -> sendLazyCommand $ GetPropertyAtIndex this n+{-# INLINE read #-}++push :: JSVal -> MutableJSArray -> JSM ()+push e (SomeJSArray x) =+    void $ withJSVal e $ \e' ->+        withObject (Object x) $ \this -> do+            f <- withJSString (JSString "push") $ sendLazyCommand . GetPropertyByName this+            withObject (Object f) $ \f' -> sendLazyCommand $ CallAsFunction f' this [e']+{-# INLINE push #-}

@@ -0,0 +1,49 @@+module JavaScript.Object.Internal+    ( Object(..)+    , create+--    , allProps+    , listProps+    , getProp+    , unsafeGetProp+    , setProp+    , unsafeSetProp+--    , isInstanceOfIO+    ) where++import Language.Javascript.JSaddle.Types (JSM, JSVal, Object(..), JSString)+import Language.Javascript.JSaddle.Native.Internal+       (withObject, withJSString, withJSVal, wrapJSString)+import Language.Javascript.JSaddle.Run+       (Command(..), AsyncCommand(..), Result(..), sendCommand, sendLazyCommand, sendAsyncCommand)++create :: JSM Object+create = Object <$> sendLazyCommand NewEmptyObject++listProps :: Object -> JSM [JSString]+listProps this =+    withObject this $ \rthis -> do+        PropertyNamesResult result <- sendCommand $ PropertyNames rthis+        mapM wrapJSString result+{-# INLINE listProps #-}++unsafeGetProp :: JSString -> Object -> JSM JSVal+unsafeGetProp name this =+    withObject this $ \rthis ->+        withJSString name $ sendLazyCommand . GetPropertyByName rthis+{-# INLINE unsafeGetProp #-}++getProp :: JSString -> Object -> JSM JSVal+getProp = unsafeGetProp+{-# INLINE getProp #-}++unsafeSetProp :: JSString -> JSVal -> Object -> JSM ()+unsafeSetProp name val this =+    withObject this $ \rthis ->+        withJSString name $ \rname ->+            withJSVal val $ \rval ->+                sendAsyncCommand $ SetPropertyByName rthis rname rval+{-# INLINE unsafeSetProp #-}++setProp :: JSString -> JSVal -> Object -> JSM ()+setProp = unsafeSetProp+{-# INLINE setProp #-}

@@ -64,12 +64,14 @@     module JSaddle ) where +import GHCJS.Marshal as JSaddle import Language.Javascript.JSaddle.Types as JSaddle import Language.Javascript.JSaddle.Classes as JSaddle+import Language.Javascript.JSaddle.Marshal.String as JSaddle () import Language.Javascript.JSaddle.Monad as JSaddle import Language.Javascript.JSaddle.Exception as JSaddle import Language.Javascript.JSaddle.Value as JSaddle-import Language.Javascript.JSaddle.Arguments as JSaddle+import Language.Javascript.JSaddle.Arguments as JSaddle () import Language.Javascript.JSaddle.Properties as JSaddle import Language.Javascript.JSaddle.Object as JSaddle import Language.Javascript.JSaddle.Evaluate as JSaddle

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- -- Module      :  Language.Javascript.JSaddle.Arguments@@ -16,18 +17,8 @@     MakeArgs(..) ) where -import Language.Javascript.JSaddle.Classes-       (ToJSVal(..))-import Language.Javascript.JSaddle.Monad (JSM)-import Language.Javascript.JSaddle.Types (JSVal)---- | Anything that can be used to make a list of JavaScript value---   references for use as function arguments-class MakeArgs this where-    makeArgs :: this -> JSM [JSVal]--instance MakeArgs arg => MakeArgs (JSM arg) where-    makeArgs arg = arg >>= makeArgs+import Language.Javascript.JSaddle.Classes (MakeArgs(..))+import GHCJS.Marshal.Internal (ToJSVal(..))  instance ToJSVal arg => MakeArgs [arg] where     makeArgs = mapM toJSVal@@ -61,7 +52,6 @@         rarg4 <- toJSVal arg4         rarg5 <- toJSVal arg5         return [rarg1, rarg2, rarg3, rarg4, rarg5]-  instance (ToJSVal arg1, ToJSVal arg2, ToJSVal arg3, ToJSVal arg4, ToJSVal arg5, ToJSVal arg6) => MakeArgs (arg1, arg2, arg3, arg4, arg5, arg6) where     makeArgs (arg1, arg2, arg3, arg4, arg5, arg6) = do

@@ -0,0 +1,121 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Rank2Types #-}+#ifdef ghcjs_HOST_OS+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE JavaScriptFFI #-}+{-# OPTIONS_GHC -Wno-dodgy-exports -Wno-dodgy-imports #-}+#endif+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+--+-- Module      :  Language.Javascript.JSaddle.Object+-- Copyright   :  (c) Hamish Mackenzie+-- License     :  MIT+--+-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | Interface to JavaScript array+--+-----------------------------------------------------------------------------++module Language.Javascript.JSaddle.Array+    ( SomeJSArray(..)+    , JSArray+    , MutableJSArray+    , create+    , length+    , lengthIO+    , nullIO+    , fromListIO+    , toListIO+    , read+    , write+    , append+    , push+    , pop+    , unshift+    , shift+    , reverse+    , takeIO+    , dropIO+    , sliceIO+    , freeze+    , unsafeFreeze+    , thaw+    , unsafeThaw+    ) where++import Prelude hiding (read, reverse, null)+import Control.Monad (void)+import Language.Javascript.JSaddle.Types+       (JSM, JSVal, SomeJSArray(..), JSArray,+        MutableJSArray)+import Control.Lens.Operators ((^.))+import Language.Javascript.JSaddle.Object (js2, js0, (##), js1, js)+import Language.Javascript.JSaddle.Value (valToNumber)+import JavaScript.Array.Internal (create, fromListIO, toListIO, read, push)++lengthIO :: SomeJSArray m -> JSM Int+lengthIO (SomeJSArray x) = round <$> (x ^. js "length" >>= valToNumber)+{-# INLINE lengthIO #-}++nullIO :: SomeJSArray m -> JSM Bool+nullIO = fmap (== 0) . lengthIO+{-# INLINE nullIO #-}++append :: SomeJSArray m -> SomeJSArray m -> JSM (SomeJSArray m1)+append (SomeJSArray x) (SomeJSArray y) = SomeJSArray <$> x ^. js1 "concat" y+{-# INLINE append #-}++write :: Int -> JSVal -> MutableJSArray -> JSM ()+write n e (SomeJSArray x) = void $ (x ## n) e+{-# INLINE write #-}++pop :: MutableJSArray -> JSM JSVal+pop (SomeJSArray x) = x ^. js0 "pop"+{-# INLINE pop #-}++unshift :: JSVal -> MutableJSArray -> JSM ()+unshift e (SomeJSArray x) = void $ x ^. js1 "unshift" e+{-# INLINE unshift #-}++shift :: MutableJSArray -> JSM JSVal+shift (SomeJSArray x) = x ^. js0 "shift"+{-# INLINE shift #-}++reverse :: MutableJSArray -> JSM ()+reverse (SomeJSArray x) = void $ x ^. js0 "reverse"+{-# INLINE reverse #-}++takeIO :: Int -> SomeJSArray m -> JSM (SomeJSArray m1)+takeIO n (SomeJSArray x) = SomeJSArray <$> x ^. js2 "slice" (0::Int) n+{-# INLINE takeIO #-}++dropIO :: Int -> SomeJSArray m -> JSM (SomeJSArray m1)+dropIO n (SomeJSArray x) = SomeJSArray <$> x ^. js1 "slice1" n+{-# INLINE dropIO #-}++sliceIO :: Int -> Int -> JSArray -> JSM (SomeJSArray m1)+sliceIO s n (SomeJSArray x) = SomeJSArray <$> x ^. js2 "slice" s n+{-# INLINE sliceIO #-}++freeze :: MutableJSArray -> JSM JSArray+freeze (SomeJSArray x) = SomeJSArray <$> x ^. js1 "slice" (0::Int)+{-# INLINE freeze #-}++unsafeFreeze :: MutableJSArray -> JSM JSArray+unsafeFreeze (SomeJSArray x) = pure (SomeJSArray x)+{-# INLINE unsafeFreeze #-}++thaw :: JSArray -> JSM MutableJSArray+thaw (SomeJSArray x) = SomeJSArray <$> x ^. js1 "slice" (0::Int)+{-# INLINE thaw #-}++unsafeThaw :: JSArray -> JSM MutableJSArray+unsafeThaw (SomeJSArray x) = pure (SomeJSArray x)+{-# INLINE unsafeThaw #-}++

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} -----------------------------------------------------------------------------@@ -16,30 +17,21 @@  module Language.Javascript.JSaddle.Classes (   -- * Type classes to convert Haskell data to JavaScript-    ToJSVal(..)+    PToJSVal(..)+  , PFromJSVal(..)+  , ToJSVal(..)+  , FromJSVal(..)   , ToJSString(..)+  , FromJSString(..)   , MakeObject(..)+  , MakeArgs(..) ) where -import Language.Javascript.JSaddle.Types-       (JSM, Object(..), JSString, JSVal)---- | Anything that can be used to make a JavaScript value reference-class ToJSVal a where-    toJSVal :: a -> JSM JSVal---- | Anything that can be used to make a JavaScript string reference-class ToJSVal a => ToJSString a where-    toJSString :: a -> JSString---- | Anything that can be used to make a JavaScript object reference-class MakeObject this where-    makeObject :: this -> JSM Object--instance ToJSVal Object where-    toJSVal (Object r) = return r---- | If we already have a Object we are fine-instance MakeObject Object where-    makeObject = return-+#ifdef ghcjs_HOST_OS+import GHCJS.Marshal (ToJSVal(..), FromJSVal(..))+#else+import GHCJS.Marshal.Internal (ToJSVal(..), FromJSVal(..))+#endif+import GHCJS.Marshal.Pure (PToJSVal(..), PFromJSVal(..))+import Language.Javascript.JSaddle.Classes.Internal (MakeObject(..), MakeArgs(..))+import Language.Javascript.JSaddle.Marshal.String (ToJSString(..), FromJSString(..))

@@ -0,0 +1,41 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+-----------------------------------------------------------------------------+--+-- Module      :  Language.Javascript.JSaddle.Classes.Internal+-- Copyright   :  (c) Hamish Mackenzie+-- License     :  MIT+--+-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | These classes are used to make various JavaScript types+--   out of whatever we have.  Functions in jsaddle take these as inputs.+--   This alows implicit casting and eager evaluation.+--+-----------------------------------------------------------------------------++module Language.Javascript.JSaddle.Classes.Internal (+  -- * Type classes to convert Haskell data to JavaScript+    MakeObject(..)+  , MakeArgs(..)+) where++import Language.Javascript.JSaddle.Types+       (JSM, Object(..), JSVal)++-- | Anything that can be used to make a JavaScript object reference+class MakeObject this where+    makeObject :: this -> JSM Object++-- | If we already have a Object we are fine+instance MakeObject Object where+    makeObject = return++-- | Anything that can be used to make a list of JavaScript value+--   references for use as function arguments+class MakeArgs this where+    makeArgs :: this -> JSM [JSVal]++instance MakeArgs arg => MakeArgs (JSM arg) where+    makeArgs arg = arg >>= makeArgs+

@@ -26,13 +26,12 @@ import Control.Monad.IO.Class (MonadIO(..)) import Language.Javascript.JSaddle.Types (JSString) #else-import Language.Javascript.JSaddle.Native+import Language.Javascript.JSaddle.Native.Internal        (withJSString) import Language.Javascript.JSaddle.Run        (AsyncCommand(..), sendLazyCommand) #endif-import Language.Javascript.JSaddle.Classes-       (ToJSString(..))+import Language.Javascript.JSaddle.Marshal.String (ToJSString(..)) import Language.Javascript.JSaddle.Monad (JSM)  -- $setup

@@ -0,0 +1,99 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+--+-- Module      :  Language.Javascript.JSaddle.Value+-- Copyright   :  (c) Hamish Mackenzie+-- License     :  MIT+--+-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | This module is like `GHCJS.Foreign` but some functions are in+--+-----------------------------------------------------------------------------+module Language.Javascript.JSaddle.Foreign (+    jsTrue+  , jsFalse+  , jsNull+  , toJSBool+--  , fromJSBoolIO+  , jsUndefined+  , isTruthyIO+  , isNullIO+  , isUndefinedIO+--  , isObjectIO+--  , isFunctionIO+--  , isStringIO+--  , isBooleanIO+--  , isSymbolIO+--  , isNumberIO+) where++#ifdef ghcjs_HOST_OS+import Language.Javascript.JSaddle.Types (JSM, JSVal)+import GHCJS.Foreign (toJSBool, isTruthy, jsNull, jsUndefined, jsTrue, jsFalse, isNull, isUndefined)+#else+import Language.Javascript.JSaddle.Types (JSM, JSVal(..))+import Language.Javascript.JSaddle.Native.Internal+       (withJSVal)+import Language.Javascript.JSaddle.Run+       (Command(..), Result(..), sendCommand)+#endif++#ifndef ghcjs_HOST_OS+jsTrue :: JSVal+jsTrue = JSVal 3+{-# INLINE jsTrue #-}++jsFalse :: JSVal+jsFalse = JSVal 2+{-# INLINE jsFalse #-}++jsNull :: JSVal+jsNull = JSVal 0+{-# INLINE jsNull #-}++toJSBool :: Bool -> JSVal+toJSBool b = JSVal $ if b then 3 else 2+{-# INLINE toJSBool #-}++jsUndefined :: JSVal+jsUndefined = JSVal 1+{-# INLINE jsUndefined #-}+#endif++isTruthyIO :: JSVal -> JSM Bool+#ifdef ghcjs_HOST_OS+isTruthyIO = return . isTruthy+#else+isTruthyIO (JSVal 0) = return False -- null+isTruthyIO (JSVal 1) = return False -- undefined+isTruthyIO (JSVal 2) = return False -- false+isTruthyIO (JSVal 3) = return True  -- true+isTruthyIO v = withJSVal v $ \rval -> do+                ValueToBoolResult result <- sendCommand (ValueToBool rval)+                return result+#endif+{-# INLINE isTruthyIO #-}++isNullIO :: JSVal -> JSM Bool+#ifdef ghcjs_HOST_OS+isNullIO = return . isNull+#else+isNullIO (JSVal 0) = return True+isNullIO v = withJSVal v $ \rval -> do+                IsNullResult result <- sendCommand $ IsNull rval+                return result+#endif+{-# INLINE isNullIO #-}++isUndefinedIO :: JSVal -> JSM Bool+#ifdef ghcjs_HOST_OS+isUndefinedIO = return . isUndefined+#else+isUndefinedIO (JSVal 1) = return True+isUndefinedIO v = withJSVal v $ \rval -> do+            IsUndefinedResult result <- sendCommand $ IsUndefined rval+            return result+#endif+{-# INLINE isUndefinedIO #-}+

@@ -0,0 +1,32 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+-----------------------------------------------------------------------------+--+-- Module      :  Language.Javascript.JSaddle.Marshal.String+-- Copyright   :  (c) Hamish Mackenzie+-- License     :  MIT+--+-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- | `JSStrings` in JSaddle (when compiled with GHC) is not a `JSVal` instead it+--   is implemented with a `Text`.+--+-----------------------------------------------------------------------------++module Language.Javascript.JSaddle.Marshal.String (+  -- * Type class to convert Haskell to JavaScript string+    ToJSString(..)+  , FromJSString(..)+) where++import Language.Javascript.JSaddle.Types (JSString)+import GHCJS.Marshal.Internal (ToJSVal(..), FromJSVal(..))++-- | Anything that can be used to make a JavaScript string+class ToJSVal a => ToJSString a where+    toJSString :: a -> JSString++-- | Anything that can be constructed from a JavaScript string+class FromJSVal a => FromJSString a where+    fromJSString :: JSString -> a+

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- -- Module      :  Language.Javascript.JSaddle.Native@@ -12,7 +11,6 @@ -----------------------------------------------------------------------------  module Language.Javascript.JSaddle.Native (-#if !defined(ghcjs_HOST_OS)     wrapJSVal   , wrapJSString   , withJSVal@@ -20,57 +18,15 @@   , withObject   , withJSString   , withToJSVal-#endif ) where -#if !defined(ghcjs_HOST_OS)-import Control.Monad.Trans.Reader (ask)-import Control.Monad.IO.Class (MonadIO(..))+import GHCJS.Marshal.Internal (ToJSVal(..)) import Language.Javascript.JSaddle.Types-       (JSContextRef(..), AsyncCommand(..), JSM(..), JSString(..),-        Object(..), JSVal(..), JSValueReceived(..), JSValueForSend(..),-        JSStringReceived(..), JSStringForSend(..), JSObjectForSend(..))-import Language.Javascript.JSaddle.Classes (ToJSVal(..))-import System.Mem.Weak (addFinalizer)-import Control.Monad.Primitive (touch)-import Control.Monad (when)--wrapJSVal :: JSValueReceived -> JSM JSVal-wrapJSVal (JSValueReceived ref) = do-    -- TODO make sure this ref has not already been wrapped (perhaps only in debug version)-    let result = JSVal ref-    when (ref >= 5) $ do-        ctx <- JSM ask-        liftIO . addFinalizer result $ doSendAsyncCommand ctx $ FreeRef $ JSValueForSend ref-    return result--wrapJSString :: MonadIO m => JSStringReceived -> m JSString-wrapJSString (JSStringReceived ref) = return $ JSString ref--withJSVal :: MonadIO m => JSVal -> (JSValueForSend -> m a) -> m a-withJSVal v@(JSVal ref) f =- do result <- f (JSValueForSend ref)-    liftIO $ touch v-    return result--withJSVals :: MonadIO m => [JSVal] -> ([JSValueForSend] -> m a) -> m a-withJSVals v f =- do result <- f (map (\(JSVal ref) -> JSValueForSend ref) v)-    liftIO $ mapM_ touch v-    return result--withObject :: MonadIO m => Object -> (JSObjectForSend -> m a) -> m a-withObject (Object o) f = withJSVal o (f . JSObjectForSend)--withJSString :: MonadIO m => JSString -> (JSStringForSend -> m a) -> m a-withJSString v@(JSString ref) f =- do result <- f (JSStringForSend ref)-    liftIO $ touch v-    return result+       (JSM(..), JSValueForSend(..))+import Language.Javascript.JSaddle.Native.Internal  withToJSVal :: ToJSVal val => val -> (JSValueForSend -> JSM a) -> JSM a withToJSVal val f = do     v <- toJSVal val     withJSVal v f-#endif 

@@ -0,0 +1,64 @@+-----------------------------------------------------------------------------+--+-- Module      :  Language.Javascript.JSaddle.Native+-- Copyright   :  (c) Hamish Mackenzie+-- License     :  MIT+--+-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+--+-- |+--+-----------------------------------------------------------------------------++module Language.Javascript.JSaddle.Native.Internal (+    wrapJSVal+  , wrapJSString+  , withJSVal+  , withJSVals+  , withObject+  , withJSString+) where++import Control.Monad.Trans.Reader (ask)+import Control.Monad.IO.Class (MonadIO(..))+import Language.Javascript.JSaddle.Types+       (JSContextRef(..), AsyncCommand(..), JSM(..), JSString(..),+        Object(..), JSVal(..), JSValueReceived(..), JSValueForSend(..),+        JSStringReceived(..), JSStringForSend(..), JSObjectForSend(..))+import System.Mem.Weak (addFinalizer)+import Control.Monad.Primitive (touch)+import Control.Monad (when)++wrapJSVal :: JSValueReceived -> JSM JSVal+wrapJSVal (JSValueReceived ref) = do+    -- TODO make sure this ref has not already been wrapped (perhaps only in debug version)+    let result = JSVal ref+    when (ref >= 5) $ do+        ctx <- JSM ask+        liftIO . addFinalizer result $ doSendAsyncCommand ctx $ FreeRef $ JSValueForSend ref+    return result++wrapJSString :: MonadIO m => JSStringReceived -> m JSString+wrapJSString (JSStringReceived ref) = return $ JSString ref++withJSVal :: MonadIO m => JSVal -> (JSValueForSend -> m a) -> m a+withJSVal v@(JSVal ref) f =+ do result <- f (JSValueForSend ref)+    liftIO $ touch v+    return result++withJSVals :: MonadIO m => [JSVal] -> ([JSValueForSend] -> m a) -> m a+withJSVals v f =+ do result <- f (map (\(JSVal ref) -> JSValueForSend ref) v)+    liftIO $ mapM_ touch v+    return result++withObject :: MonadIO m => Object -> (JSObjectForSend -> m a) -> m a+withObject (Object o) f = withJSVal o (f . JSObjectForSend)++withJSString :: MonadIO m => JSString -> (JSStringForSend -> m a) -> m a+withJSString v@(JSString ref) f =+ do result <- f (JSStringForSend ref)+    liftIO $ touch v+    return result+

@@ -22,7 +22,7 @@ -----------------------------------------------------------------------------  module Language.Javascript.JSaddle.Object (-    Object+    Object(..)   , MakeObject(..)    -- * Property lookup@@ -57,6 +57,11 @@   , new   , call   , obj+  , create+  , getProp+  , unsafeGetProp+  , setProp+  , unsafeSetProp    -- * Calling Haskell From JavaScript   , Function(..)@@ -75,12 +80,14 @@   --   and pass it to the continuation.    -- * Arrays+  , fromListIO   , array    -- * Global Object   , global    -- * Enumerating Properties+  , listProps   , propertyNames   , properties @@ -90,40 +97,42 @@   , nullObject ) where -import Control.Applicative import Prelude hiding ((!!))+import Data.Coerce (coerce) #ifdef ghcjs_HOST_OS-import GHCJS.Types (nullRef, jsval)+import GHCJS.Types (nullRef) import GHCJS.Foreign.Callback        (releaseCallback, syncCallback2, OnBlocked(..), Callback)-import GHCJS.Marshal.Pure (pFromJSVal)-import JavaScript.Array (JSArray, MutableJSArray)+import GHCJS.Marshal (ToJSVal(..))+import JavaScript.Array (MutableJSArray) import qualified JavaScript.Array as Array (toListIO, fromListIO) import JavaScript.Array.Internal (SomeJSArray(..))-import qualified JavaScript.Object as Object (create)-import Data.Coerce (coerce)+import JavaScript.Object (create, listProps) import Language.Javascript.JSaddle.Monad (JSM) import Language.Javascript.JSaddle.Types        (JSString, Object(..),         JSVal(..), JSCallAsFunction) #else+import Data.Text (Text)+import GHCJS.Marshal.Internal (ToJSVal(..)) import Language.Javascript.JSaddle.Native-       (wrapJSString, withJSVals, withObject)+       (withJSVals, withObject) import Language.Javascript.JSaddle.Run-       (Command(..), AsyncCommand(..), Result(..), sendCommand, sendLazyCommand)+       (AsyncCommand(..), sendLazyCommand) import Language.Javascript.JSaddle.Monad (askJSM, JSM) import Language.Javascript.JSaddle.Types-       (JSString, Object(..),+       (JSString, Object(..), SomeJSArray(..),         JSVal(..), JSCallAsFunction, JSContextRef(..))+import JavaScript.Object.Internal (create, listProps) #endif+import JavaScript.Array.Internal (fromListIO) import Language.Javascript.JSaddle.Value (valToObject)-import Language.Javascript.JSaddle.Classes-       (ToJSVal(..), ToJSString(..), MakeObject(..))+import Language.Javascript.JSaddle.Classes (MakeObject(..))+import Language.Javascript.JSaddle.Marshal.String (ToJSString(..)) import Language.Javascript.JSaddle.Arguments (MakeArgs(..)) import Control.Monad.IO.Class (MonadIO(..)) import Language.Javascript.JSaddle.Properties import Control.Lens (IndexPreservingGetter, to)-import Data.Text (Text)  -- $setup -- >>> import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)@@ -402,11 +411,7 @@ -- >>> testJSaddle $ do { a <- obj; (a <# "x") "Hello"; a ^. js "x" } -- Hello obj :: JSM Object-#ifdef ghcjs_HOST_OS-obj = liftIO Object.create-#else-obj = Object <$> sendLazyCommand NewEmptyObject-#endif+obj = create  -- | Short hand @::JSCallAsFunction@ so a haskell function can be passed to --   a to a JavaScipt one.@@ -487,43 +492,9 @@ -- >>> testJSaddle $ array ("Hello", JSNull, (), True, 1.0::Double) -- Hello,,,true,1 array :: MakeArgs args => args -> JSM Object-#ifdef ghcjs_HOST_OS array args = do     rargs <- makeArgs args-    liftIO $ Object . jsval <$> Array.fromListIO rargs-#else-array args = do-    rargs <- makeArgs args-    withJSVals rargs $ \rargs' -> Object <$> sendLazyCommand (NewArray rargs')-#endif---- Make an array out of various lists-instance ToJSVal [JSVal] where-    toJSVal = toJSVal . array--instance ToJSVal [JSM JSVal] where-    toJSVal = toJSVal . array--instance ToJSVal [Double] where-    toJSVal = toJSVal . array--instance ToJSVal [Float] where-    toJSVal = toJSVal . array--instance ToJSVal [Int] where-    toJSVal = toJSVal . array--instance ToJSVal [JSString] where-    toJSVal = toJSVal . array--instance ToJSVal [String] where-    toJSVal = toJSVal . array--instance ToJSVal [Text] where-    toJSVal = toJSVal . array--instance ToJSVal [Bool] where-    toJSVal = toJSVal . array+    Object . coerce <$> fromListIO rargs  -- | JavaScript's global object global :: Object@@ -541,17 +512,7 @@ -- >>> testJSaddle $ show . map strToText <$> propertyNames (eval "({x:1, y:2})") -- ["x","y"] propertyNames :: MakeObject this => this -> JSM [JSString]-#ifdef ghcjs_HOST_OS-propertyNames this = makeObject this >>= liftIO . js_propertyNames >>= liftIO . (fmap (map pFromJSVal)) . Array.toListIO-foreign import javascript unsafe "$r = []; h$forIn($1, function(n){$r.push(n);})"-    js_propertyNames :: Object -> IO JSArray-#else-propertyNames this = do-    this' <- makeObject this-    withObject this' $ \rthis -> do-        PropertyNamesResult result <- sendCommand $ PropertyNames rthis-        mapM wrapJSString result-#endif+propertyNames this = makeObject this >>= listProps  -- | Get a list containing references to all the  properties present on a given object properties :: MakeObject this => this -> JSM [JSVal]

@@ -22,44 +22,37 @@  module Language.Javascript.JSaddle.Properties (   -- * Getting Property Values-    objGetPropertyByName+    getProp, unsafeGetProp+  , objGetPropertyByName   , objGetPropertyAtIndex   -- * Setting Property Values+  , setProp, unsafeSetProp   , objSetPropertyByName   , objSetPropertyAtIndex ) where -import Language.Javascript.JSaddle.Classes-       (ToJSVal(..), ToJSString(..)) import Language.Javascript.JSaddle.Monad (JSM)-import Language.Javascript.JSaddle.Types (Object(..))+import Language.Javascript.JSaddle.Types (JSVal, Object(..))+import JavaScript.Object.Internal (getProp, unsafeGetProp, setProp, unsafeSetProp) #ifdef ghcjs_HOST_OS-import Language.Javascript.JSaddle.Types (JSString)+import GHCJS.Marshal (ToJSVal(..)) #else+import GHCJS.Marshal.Internal (ToJSVal(..)) import Language.Javascript.JSaddle.Native-       (withObject, withJSString, withToJSVal)+       (withObject, withToJSVal) import Language.Javascript.JSaddle.Run        (AsyncCommand(..), sendLazyCommand, sendAsyncCommand) #endif-import Language.Javascript.JSaddle.Value (JSVal) import Language.Javascript.JSaddle.Arguments () import Language.Javascript.JSaddle.String ()+import Language.Javascript.JSaddle.Marshal.String (ToJSString(..))  -- | Get a property value given the object and the name of the property. objGetPropertyByName :: ToJSString name                      => Object         -- ^ object to find the property on.                      -> name           -- ^ name of the property.                      -> JSM JSVal      -- ^ returns the property value.-#ifdef ghcjs_HOST_OS-objGetPropertyByName this name = js_tryGetProp (toJSString name) this-foreign import javascript unsafe "$r=$2[$1]"-    js_tryGetProp :: JSString -> Object -> IO JSVal-#else-objGetPropertyByName this name =-    withObject this $ \rthis ->-        withJSString (toJSString name) $-            sendLazyCommand . GetPropertyByName rthis-#endif+objGetPropertyByName this name = unsafeGetProp (toJSString name) this  -- | Get a property value given the object and the index of the property. objGetPropertyAtIndex :: Object    -- ^ object to find the property on.@@ -80,20 +73,9 @@                      -> name                 -- ^ name of the property.                      -> val                  -- ^ new value to set the property to.                      -> JSM ()-#ifdef ghcjs_HOST_OS objSetPropertyByName this name val = do     vref <- toJSVal val-    js_trySetProp (toJSString name) this vref-foreign import javascript unsafe "$2[$1]=$3"-    js_trySetProp :: JSString -> Object -> JSVal -> IO ()-#else-objSetPropertyByName this name val = do-    let name' = toJSString name-    withObject this $ \rthis ->-        withJSString name' $ \rname ->-            withToJSVal val $ \rval ->-                sendAsyncCommand $ SetPropertyByName rthis rname rval-#endif+    unsafeSetProp (toJSString name) vref this  -- | Set a property value given the object and the index of the property. objSetPropertyAtIndex :: (ToJSVal val)

@@ -58,7 +58,7 @@        (Command(..), AsyncCommand(..), Result(..), JSContextRef(..), JSVal(..),         Object(..), JSValueReceived(..), JSM(..), Batch(..), JSValueForSend(..)) import Language.Javascript.JSaddle.Exception (JSException(..))-import Language.Javascript.JSaddle.Native (wrapJSVal)+import Language.Javascript.JSaddle.Native.Internal (wrapJSVal) #endif  -- | Forces execution of pending asyncronous code

@@ -16,6 +16,7 @@   , jsaddleJs   , initState   , runBatch+  , ghcjsHelpers ) where  import Data.ByteString.Lazy (ByteString)@@ -166,6 +167,9 @@     \                            var s = jsaddle_values.get(d.contents) === undefined ? \"\" : JSON.stringify(jsaddle_values.get(d.contents));\n\     \                            " <> send "{\"tag\": \"ValueToJSONResult\", \"contents\": s}" <> "\n\     \                            break;\n\+    \                        case \"ValueToJSONValue\":\n\+    \                            " <> send "{\"tag\": \"ValueToJSONValueResult\", \"contents\": jsaddle_values.get(d.contents)}" <> "\n\+    \                            break;\n\     \                        case \"DeRefVal\":\n\     \                            var n = d.contents;\n\     \                            var v = jsaddle_values.get(n);\n\@@ -247,5 +251,76 @@     \    };\n\     \}\n\     \\n\+    \ " <> ghcjsHelpers <> "\     \connect();\n\+    \"++ghcjsHelpers :: ByteString+ghcjsHelpers = "\+    \function h$isNumber(o) {\+    \    return typeof(o) === 'number';\n\+    \}\n\+    \\n\+    \// returns true for null, but not for functions and host objects\n\+    \function h$isObject(o) {\n\+    \    return typeof(o) === 'object';\n\+    \}\n\+    \\n\+    \function h$isString(o) {\n\+    \    return typeof(o) === 'string';\n\+    \}\n\+    \\n\+    \function h$isSymbol(o) {\n\+    \    return typeof(o) === 'symbol';\n\+    \}\n\+    \\n\+    \function h$isBoolean(o) {\n\+    \    return typeof(o) === 'boolean';\n\+    \}\n\+    \\n\+    \function h$isFunction(o) {\n\+    \    return typeof(o) === 'function';\n\+    \}\n\+    \\n\+    \function h$jsTypeOf(o) {\n\+    \    var t = typeof(o);\n\+    \    if(t === 'undefined') return 0;\n\+    \    if(t === 'object')    return 1;\n\+    \    if(t === 'boolean')   return 2;\n\+    \    if(t === 'number')    return 3;\n\+    \    if(t === 'string')    return 4;\n\+    \    if(t === 'symbol')    return 5;\n\+    \    if(t === 'function')  return 6;\n\+    \    return 7; // other, host object etc\n\+    \}\n\+    \\n\+    \function h$jsonTypeOf(o) {\n\+    \    if (!(o instanceof Object)) {\n\+    \        if (o == null) {\n\+    \            return 0;\n\+    \        } else if (typeof o == 'number') {\n\+    \            if (h$isInteger(o)) {\n\+    \                return 1;\n\+    \            } else {\n\+    \                return 2;\n\+    \            }\n\+    \        } else if (typeof o == 'boolean') {\n\+    \            return 3;\n\+    \        } else {\n\+    \            return 4;\n\+    \        }\n\+    \    } else {\n\+    \        if (Object.prototype.toString.call(o) == '[object Array]') {\n\+    \            // it's an array\n\+    \            return 5;\n\+    \        } else if (!o) {\n\+    \            // null \n\+    \            return 0;\n\+    \        } else {\n\+    \            // it's an object\n\+    \            return 6;\n\+    \        }\n\+    \    }\n\+    \\n\+    \}\n\     \"

@@ -18,9 +18,10 @@  module Language.Javascript.JSaddle.String (     JSString-  , ToJSString(..)    -- * Data.Text helpers+  , textFromJSString+  , textToJSString   , strToText   , textToStr ) where@@ -30,21 +31,19 @@ #ifdef ghcjs_HOST_OS import Data.JSString.Text (textFromJSString, textToJSString) #endif-import Language.Javascript.JSaddle.Classes (ToJSString(..)) +#ifndef ghcjs_HOST_OS+textFromJSString :: JSString -> Text+textFromJSString (JSString text) = text++textToJSString :: Text -> JSString+textToJSString = JSString+#endif+ -- | Convert a JavaScript string to a Haskell 'Text' strToText :: JSString -> Text-#ifdef ghcjs_HOST_OS strToText = textFromJSString-#else-strToText (JSString text) = text-#endif  -- | Convert a Haskell 'Text' to a JavaScript string textToStr :: Text -> JSString-#ifdef ghcjs_HOST_OS textToStr = textToJSString-#else-textToStr = JSString-#endif-

@@ -7,6 +7,11 @@ {-# LANGUAGE UndecidableInstances       #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DefaultSignatures          #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE PolyKinds                  #-}+{-# LANGUAGE FlexibleContexts           #-} #endif ----------------------------------------------------------------------------- --@@ -31,7 +36,9 @@    -- * JavaScript Value Types   , JSVal(..)-  , MutableJSArray(..)+  , SomeJSArray(..)+  , JSArray+  , MutableJSArray   , Object(..)   , JSString(..)   , Nullable(..)@@ -55,9 +62,10 @@ #ifdef ghcjs_HOST_OS import GHCJS.Types import JavaScript.Object.Internal (Object(..))-import JavaScript.Array (MutableJSArray)+import JavaScript.Array.Internal (SomeJSArray(..), JSArray, MutableJSArray) import GHCJS.Nullable (Nullable(..)) #else+import Control.DeepSeq (NFData(..)) import Control.Monad.Trans.Reader (ReaderT(..)) import Control.Monad.Trans.State.Lazy (StateT(..)) import qualified Control.Monad.Trans.State.Strict as Strict@@ -66,11 +74,13 @@ import Control.Monad.Fix (MonadFix) import Control.Monad.Ref (MonadAtomicRef(..), MonadRef(..)) import Control.Concurrent.STM.TVar (TVar)+import Data.Coerce (Coercible, coerce) import Data.Int (Int64) import Data.Text (Text) import Data.Time.Clock (UTCTime(..))+import Data.Typeable (Typeable) import Data.Aeson-       (defaultOptions, genericToEncoding, ToJSON(..), FromJSON(..))+       (defaultOptions, genericToEncoding, ToJSON(..), FromJSON(..), Value) import GHC.Generics (Generic) #endif @@ -168,8 +178,42 @@ -- | See 'GHCJS.Prim.JSVal' newtype JSVal = JSVal JSValueRef deriving(Show, ToJSON, FromJSON) +instance NFData JSVal where+  rnf x = x `seq` ()++class IsJSVal a where+  jsval_ :: a -> JSVal++  default jsval_ :: Coercible a JSVal => a -> JSVal+  jsval_ = coerce+  {-# INLINE jsval_ #-}++jsval :: IsJSVal a => a -> JSVal+jsval = jsval_+{-# INLINE jsval #-}++data MutabilityType s = Mutable_ s+                      | Immutable_ s+                      | STMutable s++type Mutable   = Mutable_ ()+type Immutable = Immutable_ ()++data IsItMutable = IsImmutable+                 | IsMutable++type family Mutability (a :: MutabilityType s) :: IsItMutable where+  Mutability Immutable     = IsImmutable+  Mutability Mutable       = IsMutable+  Mutability (STMutable s) = IsMutable++newtype SomeJSArray (m :: MutabilityType s) = SomeJSArray JSVal+  deriving (Typeable)++-- | See 'JavaScript.Array.Internal.JSArray'+type JSArray        = SomeJSArray Immutable -- | See 'JavaScript.Array.Internal.MutableJSArray'-newtype MutableJSArray = MutableJSArray JSValueRef deriving(Show, ToJSON, FromJSON)+type MutableJSArray = SomeJSArray Mutable  -- | See 'JavaScript.Object.Internal.Object' newtype Object = Object JSVal deriving(Show, ToJSON, FromJSON)@@ -201,6 +245,7 @@                   | SetPropertyAtIndex JSObjectForSend Int JSValueForSend                   | StringToValue JSStringForSend JSValueForSend                   | NumberToValue Double JSValueForSend+                  | JSONValueToValue Value JSValueForSend                   | GetPropertyByName JSObjectForSend JSStringForSend JSValueForSend                   | GetPropertyAtIndex JSObjectForSend Int JSValueForSend                   | CallAsFunction JSObjectForSend JSObjectForSend [JSValueForSend] JSValueForSend@@ -223,6 +268,7 @@              | ValueToNumber JSValueForSend              | ValueToString JSValueForSend              | ValueToJSON JSValueForSend+             | ValueToJSONValue JSValueForSend              | IsNull JSValueForSend              | IsUndefined JSValueForSend              | StrictEqual JSValueForSend JSValueForSend@@ -251,6 +297,7 @@             | ValueToNumberResult Double             | ValueToStringResult JSStringReceived             | ValueToJSONResult JSStringReceived+            | ValueToJSONValueResult Value             | IsNullResult Bool             | IsUndefinedResult Bool             | StrictEqualResult Bool

@@ -45,6 +45,7 @@   , showJSValue    -- * Converting JavaScript values+  , isTruthyIO   , valToBool   , valToNumber   , valToStr@@ -54,15 +55,24 @@    -- * Make JavaScript values from Haskell ones   , val+  , jsNull   , valNull+  , isNullIO   , valIsNull+  , jsUndefined   , valUndefined+  , isUndefinedIO   , valIsUndefined   , maybeNullOrUndefined   , maybeNullOrUndefined'+  , toJSBool+  , jsTrue+  , jsFalse   , valBool   , valMakeNumber   , valMakeString+  , valMakeText+  , valMakeJSON    -- * Convert to and from JSValue   , deRefVal@@ -71,33 +81,35 @@   , instanceOf ) where +import Data.Text (Text)+import qualified Data.Text as T (pack, unpack)+import Data.Aeson (Value)++#ifdef ghcjs_HOST_OS import Language.Javascript.JSaddle.Types        (Object(..), JSString(..), JSVal(..))-#ifdef ghcjs_HOST_OS-import Control.Monad.IO.Class (MonadIO(..))-import GHCJS.Types (isNull, isUndefined)-import GHCJS.Foreign (toJSBool, isTruthy, jsNull, jsUndefined)-import qualified GHCJS.Marshal as GHCJS (toJSVal)+import GHCJS.Marshal (ToJSVal(..)) import GHCJS.Marshal.Pure (pToJSVal) import Data.JSString.Text (textToJSString)-import qualified Data.Text as T (pack) #else-import qualified Data.Text as T (pack, unpack)+import Data.Char (chr, ord)+import Data.Word (Word, Word8, Word16, Word32)+import Data.Int (Int8, Int16, Int32)+import GHCJS.Marshal.Internal (ToJSVal(..), FromJSVal(..))+import Language.Javascript.JSaddle.Types+       (Object(..), JSString(..), JSVal(..), JSValueForSend(..)) import Language.Javascript.JSaddle.Native-       (wrapJSString, withJSVal, withObject, withJSString,-        withToJSVal)+       (wrapJSString, withJSVal, withObject, withJSString, withToJSVal) import Language.Javascript.JSaddle.Run        (Command(..), AsyncCommand(..), Result(..), sendCommand,         sendLazyCommand) #endif import Language.Javascript.JSaddle.Monad (JSM)-import Data.Text (Text) import Language.Javascript.JSaddle.Classes-       (MakeObject(..), ToJSString(..), ToJSVal(..))+       (MakeObject(..), MakeArgs(..))+import Language.Javascript.JSaddle.Marshal.String (ToJSString(..), FromJSString(..)) import Language.Javascript.JSaddle.String (strToText, textToStr)-import Language.Javascript.JSaddle.Arguments (MakeArgs(..))-import Data.Word (Word32, Word, Word64)-import Data.Int (Int32, Int64)+import Language.Javascript.JSaddle.Foreign (jsTrue, jsFalse, jsNull, toJSBool, jsUndefined, isTruthyIO, isNullIO, isUndefinedIO)  -- $setup -- >>> import Language.Javascript.JSaddle.Test (testJSaddle)@@ -154,20 +166,7 @@ -- >>> testJSaddle $ valToBool "1" -- true valToBool :: ToJSVal value => value -> JSM Bool-#ifdef ghcjs_HOST_OS-valToBool value = isTruthy <$> toJSVal value-#else-valToBool value =-    toJSVal value >>= \case-        (JSVal 0) -> return False -- null-        (JSVal 1) -> return False -- undefined-        (JSVal 2) -> return False -- false-        (JSVal 3) -> return True  -- true-        v ->-            withJSVal v $ \rval -> do-                ValueToBoolResult result <- sendCommand (ValueToBool rval)-                return result-#endif+valToBool value = toJSVal value >>= isTruthyIO  -- | Given a JavaScript value get its numeric value. --   May throw JSException.@@ -308,15 +307,21 @@ instance MakeObject JSVal where     makeObject = valToObject +instance ToJSVal Object where+    toJSVal (Object r) = return r+ -- | Convert to a JavaScript value (just an alias for 'toJSVal') val :: ToJSVal value     => value          -- ^ value to convert to a JavaScript value     -> JSM JSVal val = toJSVal +#ifndef ghcjs_HOST_OS -- | If we already have a JSVal we are fine instance ToJSVal JSVal where     toJSVal = return+    {-# INLINE toJSVal #-}+#endif  -- | A single JSVal can be used as the argument list instance MakeArgs JSVal where@@ -326,55 +331,68 @@ --   as it returns something we can make into a JSVal. instance ToJSVal v => ToJSVal (JSM v) where     toJSVal v = v >>= toJSVal+    {-# INLINE toJSVal #-}  ----------- null --------------- -- | A @null@ JavaScript value valNull :: JSVal-#ifdef ghcjs_HOST_OS valNull = jsNull-#else-valNull = JSVal 0-#endif+{-# INLINE valNull #-}  -- | Makes a @null@ JavaScript value instance ToJSVal JSNull where-    toJSVal = const (return valNull)+    toJSVal = const (return jsNull)+    {-# INLINE toJSVal #-}  -- | Makes an argument list with just a single @null@ JavaScript value instance MakeArgs JSNull where-    makeArgs _ = return [valNull]+    makeArgs _ = return [jsNull] +#ifndef ghcjs_HOST_OS -- | Makes a JSVal or @null@ JavaScript value instance ToJSVal a => ToJSVal (Maybe a) where-    toJSVal Nothing = return valNull+    toJSVal Nothing = return jsNull     toJSVal (Just a) = toJSVal a+    {-# INLINE toJSVal #-}+instance FromJSVal a => FromJSVal (Maybe a) where+    fromJSValUnchecked x =+        isUndefinedIO x >>= \case+            True  -> return Nothing+            False -> isNullIO x >>= \case+                    True  -> return Nothing+                    False -> fromJSVal x+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal x =+        isUndefinedIO x >>= \case+            True  -> return (Just Nothing)+            False -> isNullIO x >>= \case+                    True  -> return (Just Nothing)+                    False -> fmap (fmap Just) fromJSVal x+    {-# INLINE fromJSVal #-} +-- Make an array out of various lists+instance ToJSVal a => ToJSVal [a] where+    toJSVal = toJSValListOf+    {-# INLINE toJSVal #-}++instance FromJSVal a => FromJSVal [a] where+    fromJSVal = fromJSValListOf+    {-# INLINE fromJSVal #-}+#endif+ -- | Test a JavaScript value to see if it is @null@ valIsNull :: ToJSVal value => value -> JSM Bool-#ifdef ghcjs_HOST_OS-valIsNull value = isNull <$> toJSVal value-#else-valIsNull value =-    toJSVal value >>= \case-        JSVal 0 -> return True-        v       ->-            withJSVal v $ \rval -> do-                IsNullResult result <- sendCommand $ IsNull rval-                return result-#endif+valIsNull value = toJSVal value >>= isNullIO  ----------- undefined --------------- -- | An @undefined@ JavaScript value valUndefined :: JSVal-#ifdef ghcjs_HOST_OS valUndefined = jsUndefined-#else-valUndefined = JSVal 1-#endif+{-# INLINE valUndefined #-}  -- | Makes an @undefined@ JavaScript value instance ToJSVal JSUndefined where-    toJSVal = const (return valUndefined)+    toJSVal = const (return jsUndefined)  --We can't allow this if JSUndefined is () as () is no args not "(null)". --Use [()] instead.@@ -387,16 +405,7 @@  -- | Test a JavaScript value to see if it is @undefined@ valIsUndefined :: ToJSVal value => value -> JSM Bool-#ifdef ghcjs_HOST_OS-valIsUndefined value = isUndefined <$> toJSVal value-#else-valIsUndefined value = toJSVal value >>= \case-    JSVal 1 -> return True-    v       ->-        withJSVal v $ \rval -> do-            IsUndefinedResult result <- sendCommand $ IsUndefined rval-            return result-#endif+valIsUndefined value = toJSVal value >>= isUndefinedIO  -- | Convert a JSVal to a Maybe JSVal (converting null and undefined to Nothing) maybeNullOrUndefined :: ToJSVal value => value -> JSM (Maybe JSVal)@@ -422,15 +431,15 @@ ----------- booleans --------------- -- | A JavaScript boolean value valBool :: Bool -> JSVal-#ifdef ghcjs_HOST_OS-valBool b = toJSBool b-#else-valBool b = JSVal $ if b then 3 else 2-#endif+valBool = toJSBool+{-# INLINE valBool #-} +#ifndef ghcjs_HOST_OS -- | Make a JavaScript boolean value instance ToJSVal Bool where     toJSVal = return . valBool+    {-# INLINE toJSVal #-}+#endif  -- | Makes an argument list with just a single JavaScript boolean value instance MakeArgs Bool where@@ -440,36 +449,54 @@ -- | Make a JavaScript number valMakeNumber :: Double -> JSM JSVal #ifdef ghcjs_HOST_OS-valMakeNumber n = liftIO $ GHCJS.toJSVal n+valMakeNumber n = toJSVal n #else valMakeNumber = sendLazyCommand . NumberToValue #endif +#ifndef ghcjs_HOST_OS -- | Makes a JavaScript number instance ToJSVal Double where     toJSVal = valMakeNumber+    {-# INLINE toJSVal #-}  instance ToJSVal Float where     toJSVal = valMakeNumber . realToFrac+    {-# INLINE toJSVal #-}  instance ToJSVal Word where     toJSVal = valMakeNumber . fromIntegral+    {-# INLINE toJSVal #-} -instance ToJSVal Word32 where+instance ToJSVal Word8 where     toJSVal = valMakeNumber . fromIntegral+    {-# INLINE toJSVal #-} -instance ToJSVal Word64 where+instance ToJSVal Word16 where     toJSVal = valMakeNumber . fromIntegral+    {-# INLINE toJSVal #-} +instance ToJSVal Word32 where+    toJSVal = valMakeNumber . fromIntegral+    {-# INLINE toJSVal #-}+ instance ToJSVal Int where     toJSVal = valMakeNumber . fromIntegral+    {-# INLINE toJSVal #-} -instance ToJSVal Int32 where+instance ToJSVal Int8 where     toJSVal = valMakeNumber . fromIntegral+    {-# INLINE toJSVal #-} -instance ToJSVal Int64 where+instance ToJSVal Int16 where     toJSVal = valMakeNumber . fromIntegral+    {-# INLINE toJSVal #-} +instance ToJSVal Int32 where+    toJSVal = valMakeNumber . fromIntegral+    {-# INLINE toJSVal #-}+#endif+ -- | Makes an argument list with just a single JavaScript number instance MakeArgs Double where     makeArgs n = valMakeNumber n >>= (\ref -> return [ref])@@ -491,21 +518,33 @@     withJSString s $ sendLazyCommand . StringToValue #endif +#ifndef ghcjs_HOST_OS -- | Makes a JavaScript string instance ToJSVal Text where     toJSVal = valMakeText+    {-# INLINE toJSVal #-}+instance FromJSVal Text where+    fromJSValUnchecked = valToText+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap Just . valToText+    {-# INLINE fromJSVal #-}+#endif  -- | Makes an argument list with just a single JavaScript string instance MakeArgs Text where     makeArgs t = valMakeText t >>= (\ref -> return [ref]) --- | Makes a JavaScript string-instance ToJSVal String where-    toJSVal = valMakeText . T.pack-+#ifndef ghcjs_HOST_OS -- | Makes a JavaScript string instance ToJSVal JSString where     toJSVal = valMakeString+    {-# INLINE toJSVal #-}+instance FromJSVal JSString where+    fromJSValUnchecked = valToStr+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap Just . valToStr+    {-# INLINE fromJSVal #-}+#endif  -- | If we already have a JSString we are fine instance ToJSString JSString where@@ -517,6 +556,51 @@ instance ToJSString String where     toJSString = textToStr . T.pack +instance FromJSString Text where+    fromJSString = strToText++instance FromJSString String where+    fromJSString v = T.unpack $ strToText v++instance FromJSString JSString where+    fromJSString = id++#ifndef ghcjs_HOST_OS+instance ToJSVal Char where+    toJSVal = valMakeNumber . fromIntegral . ord+    {-# INLINE toJSVal #-}+    toJSValListOf = valMakeText . T.pack+    {-# INLINE toJSValListOf #-}+instance FromJSVal Char where+    fromJSValUnchecked = fmap (chr . round) . valToNumber+    {-# INLINE fromJSValUnchecked #-}+    fromJSVal = fmap (Just . chr . round) . valToNumber+    {-# INLINE fromJSVal #-}+    fromJSValUncheckedListOf = fmap (T.unpack . strToText) . valToStr+    {-# INLINE fromJSValListOf #-}+    fromJSValListOf = fmap (Just . T.unpack . strToText) . valToStr+    {-# INLINE fromJSValUncheckedListOf #-}+#endif++-- | Make a JavaScript string from AESON `Value`+valMakeJSON :: Value -> JSM JSVal+#ifdef ghcjs_HOST_OS+valMakeJSON = toJSVal+#else+valMakeJSON = sendLazyCommand . JSONValueToValue+#endif++#ifndef ghcjs_HOST_OS+-- | Makes a JSON value+instance ToJSVal Value where+    toJSVal = valMakeJSON+    {-# INLINE toJSVal #-}+#endif++-- | Makes an argument list with just a single JSON value+instance MakeArgs Value where+    makeArgs t = valMakeJSON t >>= (\ref -> return [ref])+ -- | Derefernce a value reference. -- -- >>> testJSaddle $ showJSValue <$> deRefVal JSNull@@ -597,6 +681,7 @@ -- | Makes a JavaScript value from a 'JSValue' ADT. instance ToJSVal JSValue where     toJSVal = valMakeRef+    {-# INLINE toJSVal #-}  -- | Makes an argument list with just a single JavaScript value from a 'JSValue' ADT. instance MakeArgs JSValue where@@ -653,7 +738,6 @@             InstanceOfResult result <- sendCommand $ InstanceOf rval c'             return result #endif-