{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE LambdaCase #-}
#ifdef ghcjs_HOST_OS
{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}
{-# OPTIONS_GHC -Wno-dodgy-exports -Wno-dodgy-imports #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
--
-- Module      :  Language.Javascript.JSaddle.Value
-- Copyright   :  (c) Hamish Mackenzie
-- License     :  MIT
--
-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
--
-- | Deals with JavaScript values.  These can be
--
--   * null
--
--   * undefined
--
--   * true | false
--
--   * a double precision floating point number
--
--   * a string
--
--   * an object
--
-----------------------------------------------------------------------------

module Language.Javascript.JSaddle.Value (
  -- * JavaScript value references
    JSVal
  , ToJSVal(..)

  -- * Haskell types for JavaScript values
  , JSNull(..)
  , JSUndefined
  , JSString
  , JSValue(..)
  , showJSValue

  -- * Converting JavaScript values
  , isTruthy
  , valToBool
  , valToNumber
  , valToStr
  , valToObject
  , valToText
  , valToJSON

  -- * Make JavaScript values from Haskell ones
  , val
  , jsNull
  , valNull
  , isNull
  , valIsNull
  , jsUndefined
  , valUndefined
  , isUndefined
  , valIsUndefined
  , maybeNullOrUndefined
  , maybeNullOrUndefined'
  , toJSBool
  , jsTrue
  , jsFalse
  , valBool
  , valMakeNumber
  , valMakeString
  , valMakeText
  , valMakeJSON

  -- * Convert to and from JSValue
  , deRefVal
  , valMakeRef
  , strictEqual
  , instanceOf
) where

import Data.Text (Text)
import qualified Data.Text as T (pack, unpack)
import Data.Aeson (Value)
import Data.JSString.Text (textToJSString)

#ifdef ghcjs_HOST_OS
import Language.Javascript.JSaddle.Types
       (Object(..), JSString(..), JSVal(..), ghcjsPure)
import GHCJS.Marshal (ToJSVal(..))
#else
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(..), ghcjsPure)
import Language.Javascript.JSaddle.Native
       (valueToNumber, valueToString, valueToJSON, numberToValue, stringToValue, jsonValueToValue)
import qualified Language.Javascript.JSaddle.Native as N
       (deRefVal, strictEqual, instanceOf)
import Language.Javascript.JSaddle.Run (Result(..))
#endif
import Language.Javascript.JSaddle.Monad (JSM)
import Language.Javascript.JSaddle.Classes
       (MakeObject(..), MakeArgs(..))
import Language.Javascript.JSaddle.Marshal.String (ToJSString(..), FromJSString(..))
import Language.Javascript.JSaddle.String (strToText, textToStr)
import GHCJS.Foreign.Internal (jsTrue, jsFalse, jsNull, toJSBool, jsUndefined, isTruthy, isNull, isUndefined)

-- $setup
-- >>> import Language.Javascript.JSaddle.Test (testJSaddle)
-- >>> import Language.Javascript.JSaddle.Monad (catch)
-- >>> import Language.Javascript.JSaddle.Exception (JSException(..))
-- >>> import Language.Javascript.JSaddle.Object (obj, jsg)
-- >>> import qualified Data.Text as T (pack)

data JSNull      = JSNull -- ^ Type that represents a value that can only be null.
                          --   Haskell of course has no null so we are adding this type.
type JSUndefined = ()     -- ^ A type that can only be undefined in JavaScript.  Using ()
                          --   because functions in JavaScript that have no return, impicitly
                          --   return undefined.
-- type JSBool      = Bool   -- ^ JavaScript boolean values map the 'Bool' haskell type.
-- type JSNumber    = Double -- ^ A number in JavaScript maps nicely to 'Double'.
-- type JSString    = Text   -- ^ JavaScript strings can be represented with the Haskell 'Text' type.

-- | An algebraic data type that can represent a JavaScript value.  Any JavaScriptCore
--   'JSVal' can be converted into this type.
data JSValue = ValNull                   -- ^ null
             | ValUndefined              -- ^ undefined
             | ValBool      Bool         -- ^ true or false
             | ValNumber    Double       -- ^ a number
             | ValString    Text         -- ^ a string
             | ValObject    Object       -- ^ an object

-- | Show a JSValue but just say "object" if the value is a JavaScript object.
showJSValue :: JSValue -> String
showJSValue :: JSValue -> String
showJSValue JSValue
ValNull         = String
"null"
showJSValue JSValue
ValUndefined    = String
"undefined"
showJSValue (ValBool Bool
True)  = String
"true"
showJSValue (ValBool Bool
False) = String
"false"
showJSValue (ValNumber Double
x)   = Double -> String
forall a. Show a => a -> String
show Double
x
showJSValue (ValString Text
s)   = Text -> String
forall a. Show a => a -> String
show Text
s
showJSValue (ValObject Object
_)   = String
"object"

-- | Given a JavaScript value get its boolean value.
--   All values in JavaScript convert to bool.
--
-- >>> testJSaddle $ valToBool JSNull
-- false
-- >>> testJSaddle $ valToBool ()
-- false
-- >>> testJSaddle $ valToBool True
-- true
-- >>> testJSaddle $ valToBool False
-- false
-- >>> testJSaddle $ valToBool (1.0 :: Double)
-- true
-- >>> testJSaddle $ valToBool (0.0 :: Double)
-- false
-- >>> testJSaddle $ valToBool ""
-- false
-- >>> testJSaddle $ valToBool "1"
-- true
valToBool :: ToJSVal value => value -> JSM Bool
valToBool :: forall value. ToJSVal value => value -> JSM Bool
valToBool value
value = value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value JSM JSVal -> (JSVal -> JSM Bool) -> JSM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure Bool -> JSM Bool)
-> (JSVal -> GHCJSPure Bool) -> JSVal -> JSM Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> GHCJSPure Bool
isTruthy

-- | Given a JavaScript value get its numeric value.
--   May throw JSException.
--
-- >>> testJSaddle $ show <$> valToNumber JSNull
-- 0.0
-- >>> testJSaddle $ show <$> valToNumber ()
-- NaN
-- >>> testJSaddle $ show <$> valToNumber True
-- 1.0
-- >>> testJSaddle $ show <$> valToNumber False
-- 0.0
-- >>> testJSaddle $ show <$> valToNumber (1.0 :: Double)
-- 1.0
-- >>> testJSaddle $ show <$> valToNumber (0.0 :: Double)
-- 0.0
-- >>> testJSaddle $ show <$> valToNumber ""
-- 0.0
-- >>> testJSaddle $ show <$> valToNumber "1"
-- 1.0
valToNumber :: ToJSVal value => value -> JSM Double
#ifdef ghcjs_HOST_OS
valToNumber value = jsrefToNumber <$> toJSVal value
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ >= 900
  "(($1) => { return Number($1); })"
#else
  "$r = Number($1);"
#endif
     jsrefToNumber :: JSVal -> Double
#else
valToNumber :: forall value. ToJSVal value => value -> JSM Double
valToNumber value
value = value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM Double
valueToNumber
#endif

-- | Given a JavaScript value get its string value (as a JavaScript string).
--   May throw JSException.
--
-- >>> testJSaddle $ strToText <$> valToStr JSNull
-- null
-- >>> testJSaddle $ strToText <$> valToStr ()
-- undefined
-- >>> testJSaddle $ strToText <$> valToStr True
-- true
-- >>> testJSaddle $ strToText <$> valToStr False
-- false
-- >>> testJSaddle $ strToText <$> valToStr (1.0 :: Double)
-- 1
-- >>> testJSaddle $ strToText <$> valToStr (0.0 :: Double)
-- 0
-- >>> testJSaddle $ strToText <$> valToStr ""
-- <BLANKLINE>
-- >>> testJSaddle $ strToText <$> valToStr "1"
-- 1
valToStr :: ToJSVal value => value -> JSM JSString
#ifdef ghcjs_HOST_OS
valToStr value = jsrefToString <$> toJSVal value
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ >= 900
  "(($1) => { return $1.toString(); })"
#else
  "$r = $1.toString();"
#endif
    jsrefToString :: JSVal -> JSString
#else
valToStr :: forall value. ToJSVal value => value -> JSM JSString
valToStr value
value = value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value JSM JSVal -> (JSVal -> JSM JSString) -> JSM JSString
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM JSString
valueToString
#endif

-- | Given a JavaScript value get its string value (as a Haskell 'Text').
--   May throw JSException.
--
-- >>> testJSaddle $ show <$> valToText JSNull
-- "null"
-- >>> testJSaddle $ show <$> valToText ()
-- "undefined"
-- >>> testJSaddle $ show <$> valToText True
-- "true"
-- >>> testJSaddle $ show <$> valToText False
-- "false"
-- >>> testJSaddle $ show <$> valToText (1.0 :: Double)
-- "1"
-- >>> testJSaddle $ show <$> valToText (0.0 :: Double)
-- "0"
-- >>> testJSaddle $ show <$> valToText ""
-- ""
-- >>> testJSaddle $ show <$> valToText "1"
-- "1"
valToText :: ToJSVal value => value -> JSM Text
valToText :: forall value. ToJSVal value => value -> JSM Text
valToText value
jsvar = JSString -> Text
strToText (JSString -> Text) -> JSM JSString -> JSM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> value -> JSM JSString
forall value. ToJSVal value => value -> JSM JSString
valToStr value
jsvar

-- | Given a JavaScript value get a JSON string value.
--   May throw JSException.
--
-- >>> testJSaddle $ strToText <$> valToJSON JSNull
-- null
-- >>> testJSaddle $ strToText <$> valToJSON ()
-- <BLANKLINE>
-- >>> testJSaddle $ strToText <$> valToJSON True
-- true
-- >>> testJSaddle $ strToText <$> valToJSON False
-- false
-- >>> testJSaddle $ strToText <$> valToJSON (1.0 :: Double)
-- 1
-- >>> testJSaddle $ strToText <$> valToJSON (0.0 :: Double)
-- 0
-- >>> testJSaddle $ strToText <$> valToJSON ""
-- ""
-- >>> testJSaddle $ strToText <$> valToJSON "1"
-- "1"
-- >>> testJSaddle $ strToText <$> (obj >>= valToJSON)
-- {}
valToJSON :: ToJSVal value => value -> JSM JSString
#ifdef ghcjs_HOST_OS
valToJSON value = jsrefToJSON <$> toJSVal value
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ >= 900
  "(($1) => { return $1 === undefined ? \"\" : JSON.stringify($1); })"
#else
  "$r = $1 === undefined ? \"\" : JSON.stringify($1);"
#endif
    jsrefToJSON :: JSVal -> JSString
#else
valToJSON :: forall value. ToJSVal value => value -> JSM JSString
valToJSON value
value = value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value JSM JSVal -> (JSVal -> JSM JSString) -> JSM JSString
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM JSString
valueToJSON
#endif

-- | Given a JavaScript value get its object value.
--   May throw JSException.
--
-- >>> testJSaddle $ (valToObject JSNull >>= valToText) `catch` \ (JSException e) -> valToText e
-- null
-- >>> testJSaddle $ (valToObject () >>= valToText) `catch` \ (JSException e) -> valToText e
-- undefined
-- >>> testJSaddle $ valToObject True
-- true
-- >>> testJSaddle $ valToObject False
-- false
-- >>> testJSaddle $ valToObject (1.0 :: Double)
-- 1
-- >>> testJSaddle $ valToObject (0.0 :: Double)
-- 0
-- >>> testJSaddle $ valToObject ""
-- <BLANKLINE>
-- >>> testJSaddle $ valToObject "1"
-- 1
valToObject :: ToJSVal value => value -> JSM Object
valToObject :: forall value. ToJSVal value => value -> JSM Object
valToObject value
value = JSVal -> Object
Object (JSVal -> Object) -> JSM JSVal -> JSM Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value

instance MakeObject JSVal where
    makeObject :: JSVal -> JSM Object
makeObject = Object -> JSM Object
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> JSM Object) -> (JSVal -> Object) -> JSVal -> JSM Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> Object
Object

instance ToJSVal Object where
    toJSVal :: Object -> JSM JSVal
toJSVal (Object JSVal
r) = JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
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 :: forall a. ToJSVal a => a -> JSM JSVal
val = value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal

#ifndef ghcjs_HOST_OS
-- | If we already have a JSVal we are fine
instance ToJSVal JSVal where
    toJSVal :: JSVal -> JSM JSVal
toJSVal = JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return
    {-# INLINE toJSVal #-}
#endif

-- | A single JSVal can be used as the argument list
instance MakeArgs JSVal where
    makeArgs :: JSVal -> JSM [JSVal]
makeArgs JSVal
arg = [JSVal] -> JSM [JSVal]
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return [JSVal
arg]

-- | JSVal can be made by evaluating a function in 'JSM' as long
--   as it returns something we can make into a JSVal.
instance ToJSVal v => ToJSVal (JSM v) where
    toJSVal :: JSM v -> JSM JSVal
toJSVal JSM v
v = JSM v
v JSM v -> (v -> JSM JSVal) -> JSM JSVal
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= v -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal
    {-# INLINE toJSVal #-}

----------- null ---------------
-- | A @null@ JavaScript value
valNull :: JSVal
valNull :: JSVal
valNull = JSVal
jsNull
{-# INLINE valNull #-}

-- | Makes a @null@ JavaScript value
instance ToJSVal JSNull where
    toJSVal :: JSNull -> JSM JSVal
toJSVal = JSM JSVal -> JSNull -> JSM JSVal
forall a b. a -> b -> a
const (JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
jsNull)
    {-# INLINE toJSVal #-}

-- | Makes an argument list with just a single @null@ JavaScript value
instance MakeArgs JSNull where
    makeArgs :: JSNull -> JSM [JSVal]
makeArgs JSNull
_ = [JSVal] -> JSM [JSVal]
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return [JSVal
jsNull]

#ifndef ghcjs_HOST_OS
-- | Makes a JSVal or @null@ JavaScript value
instance ToJSVal a => ToJSVal (Maybe a) where
    toJSVal :: Maybe a -> JSM JSVal
toJSVal Maybe a
Nothing = JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
jsNull
    toJSVal (Just a
a) = a -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal a
a
    {-# INLINE toJSVal #-}
instance FromJSVal a => FromJSVal (Maybe a) where
    fromJSValUnchecked :: JSVal -> JSM (Maybe a)
fromJSValUnchecked JSVal
x =
        GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isUndefined JSVal
x) JSM Bool -> (Bool -> JSM (Maybe a)) -> JSM (Maybe a)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
True  -> Maybe a -> JSM (Maybe a)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
            Bool
False -> GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isNull JSVal
x) JSM Bool -> (Bool -> JSM (Maybe a)) -> JSM (Maybe a)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Bool
True  -> Maybe a -> JSM (Maybe a)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                    Bool
False -> JSVal -> JSM (Maybe a)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal JSVal
x
    {-# INLINE fromJSValUnchecked #-}
    fromJSVal :: JSVal -> JSM (Maybe (Maybe a))
fromJSVal JSVal
x =
        GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isUndefined JSVal
x) JSM Bool
-> (Bool -> JSM (Maybe (Maybe a))) -> JSM (Maybe (Maybe a))
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
True  -> Maybe (Maybe a) -> JSM (Maybe (Maybe a))
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing)
            Bool
False -> GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isNull JSVal
x) JSM Bool
-> (Bool -> JSM (Maybe (Maybe a))) -> JSM (Maybe (Maybe a))
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Bool
True  -> Maybe (Maybe a) -> JSM (Maybe (Maybe a))
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing)
                    Bool
False -> (JSM (Maybe a) -> JSM (Maybe (Maybe a)))
-> (JSVal -> JSM (Maybe a)) -> JSVal -> JSM (Maybe (Maybe a))
forall a b. (a -> b) -> (JSVal -> a) -> JSVal -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe a -> Maybe (Maybe a))
-> JSM (Maybe a) -> JSM (Maybe (Maybe a))
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just) JSVal -> JSM (Maybe a)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal JSVal
x
    {-# INLINE fromJSVal #-}

-- Make an array out of various lists
instance ToJSVal a => ToJSVal [a] where
    toJSVal :: [a] -> JSM JSVal
toJSVal = [a] -> JSM JSVal
forall a. ToJSVal a => [a] -> JSM JSVal
toJSValListOf
    {-# INLINE toJSVal #-}

instance FromJSVal a => FromJSVal [a] where
    fromJSVal :: JSVal -> JSM (Maybe [a])
fromJSVal = JSVal -> JSM (Maybe [a])
forall a. FromJSVal a => JSVal -> JSM (Maybe [a])
fromJSValListOf
    {-# INLINE fromJSVal #-}
#endif

-- | Test a JavaScript value to see if it is @null@
valIsNull :: ToJSVal value => value -> JSM Bool
valIsNull :: forall value. ToJSVal value => value -> JSM Bool
valIsNull value
value = value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value JSM JSVal -> (JSVal -> JSM Bool) -> JSM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure Bool -> JSM Bool)
-> (JSVal -> GHCJSPure Bool) -> JSVal -> JSM Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> GHCJSPure Bool
isNull

----------- undefined ---------------
-- | An @undefined@ JavaScript value
valUndefined :: JSVal
valUndefined :: JSVal
valUndefined = JSVal
jsUndefined
{-# INLINE valUndefined #-}

-- | Makes an @undefined@ JavaScript value
instance ToJSVal JSUndefined where
    toJSVal :: JSUndefined -> JSM JSVal
toJSVal = JSM JSVal -> JSUndefined -> JSM JSVal
forall a b. a -> b -> a
const (JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
jsUndefined)

--We can't allow this if JSUndefined is () as () is no args not "(null)".
--Use [()] instead.
--instance MakeArgs JSUndefined where
--    makeArgs _ = valMakeUndefined >>= (\ref -> return [ref])

-- | This allows us to pass no arguments easily (altenative would be to use @[]::[JSVal]@).
instance MakeArgs () where
    makeArgs :: JSUndefined -> JSM [JSVal]
makeArgs JSUndefined
_ = [JSVal] -> JSM [JSVal]
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Test a JavaScript value to see if it is @undefined@
valIsUndefined :: ToJSVal value => value -> JSM Bool
valIsUndefined :: forall value. ToJSVal value => value -> JSM Bool
valIsUndefined value
value = value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value JSM JSVal -> (JSVal -> JSM Bool) -> JSM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure Bool -> JSM Bool)
-> (JSVal -> GHCJSPure Bool) -> JSVal -> JSM Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> GHCJSPure Bool
isUndefined

-- | Convert a JSVal to a Maybe JSVal (converting null and undefined to Nothing)
maybeNullOrUndefined :: ToJSVal value => value -> JSM (Maybe JSVal)
maybeNullOrUndefined :: forall value. ToJSVal value => value -> JSM (Maybe JSVal)
maybeNullOrUndefined value
value = do
    JSVal
rval <- value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value
    GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isNull JSVal
rval) JSM Bool -> (Bool -> JSM (Maybe JSVal)) -> JSM (Maybe JSVal)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> Maybe JSVal -> JSM (Maybe JSVal)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe JSVal
forall a. Maybe a
Nothing
        Bool
_    ->
            GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isUndefined JSVal
rval) JSM Bool -> (Bool -> JSM (Maybe JSVal)) -> JSM (Maybe JSVal)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Bool
True -> Maybe JSVal -> JSM (Maybe JSVal)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe JSVal
forall a. Maybe a
Nothing
                Bool
_    -> Maybe JSVal -> JSM (Maybe JSVal)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSVal -> Maybe JSVal
forall a. a -> Maybe a
Just JSVal
rval)

maybeNullOrUndefined' :: ToJSVal value => (JSVal -> JSM a) -> value -> JSM (Maybe a)
maybeNullOrUndefined' :: forall value a.
ToJSVal value =>
(JSVal -> JSM a) -> value -> JSM (Maybe a)
maybeNullOrUndefined' JSVal -> JSM a
f value
value = do
    JSVal
rval <- value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value
    GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isNull JSVal
rval) JSM Bool -> (Bool -> JSM (Maybe a)) -> JSM (Maybe a)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> Maybe a -> JSM (Maybe a)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        Bool
_    ->
            GHCJSPure Bool -> JSM Bool
forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isUndefined JSVal
rval) JSM Bool -> (Bool -> JSM (Maybe a)) -> JSM (Maybe a)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Bool
True -> Maybe a -> JSM (Maybe a)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                Bool
_    -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> JSM a -> JSM (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> JSM a
f JSVal
rval

----------- booleans ---------------
-- | A JavaScript boolean value
valBool :: Bool -> JSVal
valBool :: Bool -> JSVal
valBool = Bool -> JSVal
toJSBool
{-# INLINE valBool #-}

#ifndef ghcjs_HOST_OS
-- | Make a JavaScript boolean value
instance ToJSVal Bool where
    toJSVal :: Bool -> JSM JSVal
toJSVal = JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSVal -> JSM JSVal) -> (Bool -> JSVal) -> Bool -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> JSVal
valBool
    {-# INLINE toJSVal #-}
#endif

-- | Makes an argument list with just a single JavaScript boolean value
instance MakeArgs Bool where
    makeArgs :: Bool -> JSM [JSVal]
makeArgs Bool
b = [JSVal] -> JSM [JSVal]
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool -> JSVal
valBool Bool
b]

----------- numbers ---------------
-- | Make a JavaScript number
valMakeNumber :: Double -> JSM JSVal
valMakeNumber :: Double -> JSM JSVal
valMakeNumber = Double -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal
{-# INLINE valMakeNumber #-}

#ifndef ghcjs_HOST_OS
-- | Makes a JavaScript number
instance ToJSVal Double where
    toJSVal :: Double -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue
    {-# INLINE toJSVal #-}

instance ToJSVal Float where
    toJSVal :: Float -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue (Double -> JSM JSVal) -> (Float -> Double) -> Float -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
    {-# INLINE toJSVal #-}

instance ToJSVal Word where
    toJSVal :: Word -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue (Double -> JSM JSVal) -> (Word -> Double) -> Word -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toJSVal #-}

instance ToJSVal Word8 where
    toJSVal :: Word8 -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue (Double -> JSM JSVal) -> (Word8 -> Double) -> Word8 -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toJSVal #-}

instance ToJSVal Word16 where
    toJSVal :: Word16 -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue (Double -> JSM JSVal) -> (Word16 -> Double) -> Word16 -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toJSVal #-}

instance ToJSVal Word32 where
    toJSVal :: Word32 -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue (Double -> JSM JSVal) -> (Word32 -> Double) -> Word32 -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toJSVal #-}

instance ToJSVal Int where
    toJSVal :: Int -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue (Double -> JSM JSVal) -> (Int -> Double) -> Int -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toJSVal #-}

instance ToJSVal Int8 where
    toJSVal :: Int8 -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue (Double -> JSM JSVal) -> (Int8 -> Double) -> Int8 -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toJSVal #-}

instance ToJSVal Int16 where
    toJSVal :: Int16 -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue (Double -> JSM JSVal) -> (Int16 -> Double) -> Int16 -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toJSVal #-}

instance ToJSVal Int32 where
    toJSVal :: Int32 -> JSM JSVal
toJSVal = Double -> JSM JSVal
numberToValue (Double -> JSM JSVal) -> (Int32 -> Double) -> Int32 -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toJSVal #-}
#endif

-- | Makes an argument list with just a single JavaScript number
instance MakeArgs Double where
    makeArgs :: Double -> JSM [JSVal]
makeArgs Double
n = Double -> JSM JSVal
valMakeNumber Double
n JSM JSVal -> (JSVal -> JSM [JSVal]) -> JSM [JSVal]
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\JSVal
ref -> [JSVal] -> JSM [JSVal]
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return [JSVal
ref])

-- | Make a JavaScript string from `Text`
valMakeText :: Text -> JSM JSVal
valMakeText :: Text -> JSM JSVal
valMakeText = JSString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (JSString -> JSM JSVal) -> (Text -> JSString) -> Text -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> JSString
textToJSString
{-# INLINE valMakeText #-}

-- | Make a JavaScript string from `JSString`
valMakeString :: JSString -> JSM JSVal
valMakeString :: JSString -> JSM JSVal
valMakeString = JSString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal
{-# INLINE valMakeString #-}

#ifndef ghcjs_HOST_OS
-- | Makes a JavaScript string
instance ToJSVal Text where
    toJSVal :: Text -> JSM JSVal
toJSVal = JSString -> JSM JSVal
stringToValue (JSString -> JSM JSVal) -> (Text -> JSString) -> Text -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> JSString
JSString
    {-# INLINE toJSVal #-}
instance FromJSVal Text where
    fromJSValUnchecked :: JSVal -> JSM Text
fromJSValUnchecked = JSVal -> JSM Text
forall value. ToJSVal value => value -> JSM Text
valToText
    {-# INLINE fromJSValUnchecked #-}
    fromJSVal :: JSVal -> JSM (Maybe Text)
fromJSVal = (Text -> Maybe Text) -> JSM Text -> JSM (Maybe Text)
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (JSM Text -> JSM (Maybe Text))
-> (JSVal -> JSM Text) -> JSVal -> JSM (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM Text
forall value. ToJSVal value => value -> JSM Text
valToText
    {-# INLINE fromJSVal #-}
#endif

-- | Makes an argument list with just a single JavaScript string
instance MakeArgs Text where
    makeArgs :: Text -> JSM [JSVal]
makeArgs Text
t = Text -> JSM JSVal
valMakeText Text
t JSM JSVal -> (JSVal -> JSM [JSVal]) -> JSM [JSVal]
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\JSVal
ref -> [JSVal] -> JSM [JSVal]
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return [JSVal
ref])

#ifndef ghcjs_HOST_OS
-- | Makes a JavaScript string
instance ToJSVal JSString where
    toJSVal :: JSString -> JSM JSVal
toJSVal = JSString -> JSM JSVal
stringToValue
    {-# INLINE toJSVal #-}
instance FromJSVal JSString where
    fromJSValUnchecked :: JSVal -> JSM JSString
fromJSValUnchecked = JSVal -> JSM JSString
forall value. ToJSVal value => value -> JSM JSString
valToStr
    {-# INLINE fromJSValUnchecked #-}
    fromJSVal :: JSVal -> JSM (Maybe JSString)
fromJSVal = (JSString -> Maybe JSString)
-> JSM JSString -> JSM (Maybe JSString)
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JSString -> Maybe JSString
forall a. a -> Maybe a
Just (JSM JSString -> JSM (Maybe JSString))
-> (JSVal -> JSM JSString) -> JSVal -> JSM (Maybe JSString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM JSString
forall value. ToJSVal value => value -> JSM JSString
valToStr
    {-# INLINE fromJSVal #-}
#endif

-- | If we already have a JSString we are fine
instance ToJSString JSString where
    toJSString :: JSString -> JSString
toJSString = JSString -> JSString
forall a. a -> a
id

instance ToJSString Text where
    toJSString :: Text -> JSString
toJSString = Text -> JSString
textToStr

instance ToJSString String where
    toJSString :: String -> JSString
toJSString = Text -> JSString
textToStr (Text -> JSString) -> (String -> Text) -> String -> JSString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance FromJSString Text where
    fromJSString :: JSString -> Text
fromJSString = JSString -> Text
strToText

instance FromJSString String where
    fromJSString :: JSString -> String
fromJSString JSString
v = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ JSString -> Text
strToText JSString
v

instance FromJSString JSString where
    fromJSString :: JSString -> JSString
fromJSString = JSString -> JSString
forall a. a -> a
id

#ifndef ghcjs_HOST_OS
instance ToJSVal Char where
    toJSVal :: Char -> JSM JSVal
toJSVal = Double -> JSM JSVal
valMakeNumber (Double -> JSM JSVal) -> (Char -> Double) -> Char -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> (Char -> Int) -> Char -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
    {-# INLINE toJSVal #-}
    toJSValListOf :: String -> JSM JSVal
toJSValListOf = Text -> JSM JSVal
valMakeText (Text -> JSM JSVal) -> (String -> Text) -> String -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    {-# INLINE toJSValListOf #-}
instance FromJSVal Char where
    fromJSValUnchecked :: JSVal -> JSM Char
fromJSValUnchecked = (Double -> Char) -> JSM Double -> JSM Char
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr (Int -> Char) -> (Double -> Int) -> Double -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round) (JSM Double -> JSM Char)
-> (JSVal -> JSM Double) -> JSVal -> JSM Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber
    {-# INLINE fromJSValUnchecked #-}
    fromJSVal :: JSVal -> JSM (Maybe Char)
fromJSVal = (Double -> Maybe Char) -> JSM Double -> JSM (Maybe Char)
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> (Double -> Char) -> Double -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr (Int -> Char) -> (Double -> Int) -> Double -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round) (JSM Double -> JSM (Maybe Char))
-> (JSVal -> JSM Double) -> JSVal -> JSM (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber
    {-# INLINE fromJSVal #-}
    fromJSValUncheckedListOf :: JSVal -> JSM String
fromJSValUncheckedListOf = (JSString -> String) -> JSM JSString -> JSM String
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
T.unpack (Text -> String) -> (JSString -> Text) -> JSString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSString -> Text
strToText) (JSM JSString -> JSM String)
-> (JSVal -> JSM JSString) -> JSVal -> JSM String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM JSString
forall value. ToJSVal value => value -> JSM JSString
valToStr
    {-# INLINE fromJSValListOf #-}
    fromJSValListOf :: JSVal -> JSM (Maybe String)
fromJSValListOf = (JSString -> Maybe String) -> JSM JSString -> JSM (Maybe String)
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (JSString -> String) -> JSString -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (JSString -> Text) -> JSString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSString -> Text
strToText) (JSM JSString -> JSM (Maybe String))
-> (JSVal -> JSM JSString) -> JSVal -> JSM (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM JSString
forall value. ToJSVal value => value -> JSM JSString
valToStr
    {-# INLINE fromJSValUncheckedListOf #-}
#endif

-- | Make a JavaScript string from AESON `Value`
valMakeJSON :: Value -> JSM JSVal
valMakeJSON :: Value -> JSM JSVal
valMakeJSON = Value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal

#ifndef ghcjs_HOST_OS
-- | Makes a JSON value
instance ToJSVal Value where
    toJSVal :: Value -> JSM JSVal
toJSVal = Value -> JSM JSVal
jsonValueToValue
    {-# INLINE toJSVal #-}
#endif

-- | Makes an argument list with just a single JSON value
instance MakeArgs Value where
    makeArgs :: Value -> JSM [JSVal]
makeArgs Value
t = Value -> JSM JSVal
valMakeJSON Value
t JSM JSVal -> (JSVal -> JSM [JSVal]) -> JSM [JSVal]
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\JSVal
ref -> [JSVal] -> JSM [JSVal]
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return [JSVal
ref])

-- | Derefernce a value reference.
--
-- >>> testJSaddle $ showJSValue <$> deRefVal JSNull
-- null
-- >>> testJSaddle $ showJSValue <$> deRefVal ()
-- undefined
-- >>> testJSaddle $ showJSValue <$> deRefVal True
-- true
-- >>> testJSaddle $ showJSValue <$> deRefVal False
-- false
-- >>> testJSaddle $ showJSValue <$> deRefVal (1.0 :: Double)
-- 1.0
-- >>> testJSaddle $ showJSValue <$> deRefVal (0.0 :: Double)
-- 0.0
-- >>> testJSaddle $ showJSValue <$> deRefVal ""
-- ""
-- >>> testJSaddle $ showJSValue <$> deRefVal "1"
-- "1"
-- >>> testJSaddle $ showJSValue <$> (valToObject True >>= deRefVal)
-- true
-- >>> testJSaddle $ showJSValue <$> (obj >>= deRefVal)
-- object
deRefVal :: ToJSVal value => value -> JSM JSValue
#ifdef ghcjs_HOST_OS
deRefVal value = do
    valref <- toJSVal value
    case (jsrefGetType valref :: Int) of
        0 -> return ValUndefined
        1 -> return ValNull
        2 -> ValBool   <$> valToBool valref
        3 -> ValNumber <$> valToNumber valref
        4 -> ValString <$> valToText valref
        5 -> ValObject <$> valToObject valref
        _ -> error "Unexpected result dereferencing JSaddle value"
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ >= 900
  "(($1) => { return ($1 === undefined)?0:\
                     ($1===null)?1:\
                     (typeof $1===\"boolean\")?2:\
                     (typeof $1===\"number\")?3:\
                     (typeof $1===\"string\")?4:\
                     (typeof $1===\"object\")?5:-1; })"
#else
  "$r = ($1 === undefined)?0:\
        ($1===null)?1:\
        (typeof $1===\"boolean\")?2:\
        (typeof $1===\"number\")?3:\
        (typeof $1===\"string\")?4:\
        (typeof $1===\"object\")?5:-1;"
#endif
    jsrefGetType :: JSVal -> Int
#else
deRefVal :: forall value. ToJSVal value => value -> JSM JSValue
deRefVal value
value = do
    JSVal
v <- value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value
    Result
result <- JSVal -> JSM Result
N.deRefVal JSVal
v
    JSValue -> JSM JSValue
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSValue -> JSM JSValue) -> JSValue -> JSM JSValue
forall a b. (a -> b) -> a -> b
$ case Result
result of
        DeRefValResult JSValueRef
0    Text
_ -> JSValue
ValNull
        DeRefValResult JSValueRef
1    Text
_ -> JSValue
ValUndefined
        DeRefValResult JSValueRef
2    Text
_ -> Bool -> JSValue
ValBool Bool
False
        DeRefValResult JSValueRef
3    Text
_ -> Bool -> JSValue
ValBool Bool
True
        DeRefValResult (-1) Text
s -> Double -> JSValue
ValNumber (String -> Double
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
s))
        DeRefValResult (-2) Text
s -> Text -> JSValue
ValString Text
s
        DeRefValResult (-3) Text
_ -> Object -> JSValue
ValObject (JSVal -> Object
Object JSVal
v)
        Result
_                     -> String -> JSValue
forall a. HasCallStack => String -> a
error String
"Unexpected result dereferencing JSaddle value"
#endif

-- | Make a JavaScript value out of a 'JSValue' ADT.
--
-- >>> testJSaddle $ valMakeRef ValNull
-- null
-- >>> testJSaddle $ valMakeRef ValUndefined
-- undefined
-- >>> testJSaddle $ valMakeRef (ValBool True)
-- true
-- >>> testJSaddle $ valMakeRef (ValNumber 1)
-- 1
-- >>> testJSaddle $ valMakeRef (ValString $ T.pack "Hello")
-- Hello
valMakeRef :: JSValue -> JSM JSVal
valMakeRef :: JSValue -> JSM JSVal
valMakeRef JSValue
value =
    case JSValue
value of
        JSValue
ValNull              -> JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
valNull
        JSValue
ValUndefined         -> JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
valUndefined
        ValBool Bool
b            -> JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSVal -> JSM JSVal) -> JSVal -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ Bool -> JSVal
valBool Bool
b
        ValNumber Double
n          -> Double -> JSM JSVal
valMakeNumber Double
n
        ValString Text
s          -> Text -> JSM JSVal
valMakeText Text
s
        ValObject (Object JSVal
o) -> JSVal -> JSM JSVal
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
o

-- | Makes a JavaScript value from a 'JSValue' ADT.
instance ToJSVal JSValue where
    toJSVal :: JSValue -> JSM JSVal
toJSVal = JSValue -> JSM JSVal
valMakeRef
    {-# INLINE toJSVal #-}

-- | Makes an argument list with just a single JavaScript value from a 'JSValue' ADT.
instance MakeArgs JSValue where
    makeArgs :: JSValue -> JSM [JSVal]
makeArgs JSValue
v = JSValue -> JSM JSVal
valMakeRef JSValue
v JSM JSVal -> (JSVal -> JSM [JSVal]) -> JSM [JSVal]
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\JSVal
ref -> [JSVal] -> JSM [JSVal]
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return [JSVal
ref])

--instance MakeObjectRef JSNull where
--    makeObjectRef _ = Object <$> valMakeNull
--    {-# INLINE makeObjectRef #-}

#ifdef ghcjs_HOST_OS
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ >= 900
  "(($1,$2) => { return $1===$2; })"
#else
  "$1===$2"
#endif
    jsvalueisstrictequal :: JSVal -> JSVal -> Bool
#endif

-- | Determine if two values are equal (JavaScripts ===)
-- >>> testJSaddle $ strictEqual True False
-- false
-- >>> testJSaddle $ strictEqual True True
-- true
-- >>> testJSaddle $ strictEqual "Hello" ()
-- false
-- >>> testJSaddle $ strictEqual "Hello" "Hello"
-- true
strictEqual :: (ToJSVal a, ToJSVal b) => a -> b -> JSM Bool
strictEqual :: forall a b. (ToJSVal a, ToJSVal b) => a -> b -> JSM Bool
strictEqual a
a b
b = do
    JSVal
aval <- a -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal a
a
    JSVal
bval <- b -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal b
b
#ifdef ghcjs_HOST_OS
    return $ jsvalueisstrictequal aval bval
#else
    JSVal -> JSVal -> JSM Bool
N.strictEqual JSVal
aval JSVal
bval
#endif

#ifdef ghcjs_HOST_OS
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ >= 900
  "(($1,$2) => { return $1 instanceof $2; })"
#else
  "$1 instanceof $2"
#endif
  js_isInstanceOf :: JSVal -> Object -> Bool
#endif

-- | Determine if two values are equal (JavaScripts ===)
-- >>> testJSaddle $ instanceOf obj (Object <$> jsg "Object")
-- true
instanceOf :: (ToJSVal value, MakeObject constructor) => value -> constructor -> JSM Bool
instanceOf :: forall value constructor.
(ToJSVal value, MakeObject constructor) =>
value -> constructor -> JSM Bool
instanceOf value
value constructor
constructor = do
    JSVal
v <- value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value
    Object
c <- constructor -> JSM Object
forall this. MakeObject this => this -> JSM Object
makeObject constructor
constructor
#ifdef ghcjs_HOST_OS
    return $ js_isInstanceOf v c
#else
    JSVal -> Object -> JSM Bool
N.instanceOf JSVal
v Object
c
#endif