#ifdef ghcjs_HOST_OS
#endif
module Language.Javascript.JSaddle.Value (
JSVal
, ToJSVal(..)
, JSNull(..)
, JSUndefined
, JSString
, JSValue(..)
, showJSValue
, isTruthy
, valToBool
, valToNumber
, valToStr
, valToObject
, valToText
, valToJSON
, val
, jsNull
, valNull
, isNull
, valIsNull
, jsUndefined
, valUndefined
, isUndefined
, valIsUndefined
, maybeNullOrUndefined
, maybeNullOrUndefined'
, toJSBool
, jsTrue
, jsFalse
, valBool
, valMakeNumber
, valMakeString
, valMakeText
, valMakeJSON
, 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)
data JSNull = JSNull
type JSUndefined = ()
data JSValue = ValNull
| ValUndefined
| ValBool Bool
| ValNumber Double
| ValString Text
| ValObject Object
showJSValue :: JSValue -> String
showJSValue ValNull = "null"
showJSValue ValUndefined = "undefined"
showJSValue (ValBool True) = "true"
showJSValue (ValBool False) = "false"
showJSValue (ValNumber x) = show x
showJSValue (ValString s) = show s
showJSValue (ValObject _) = "object"
valToBool :: ToJSVal value => value -> JSM Bool
valToBool value = toJSVal value >>= ghcjsPure . isTruthy
valToNumber :: ToJSVal value => value -> JSM Double
#ifdef ghcjs_HOST_OS
valToNumber value = jsrefToNumber <$> toJSVal value
foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSVal -> Double
#else
valToNumber value = toJSVal value >>= valueToNumber
#endif
valToStr :: ToJSVal value => value -> JSM JSString
#ifdef ghcjs_HOST_OS
valToStr value = jsrefToString <$> toJSVal value
foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSVal -> JSString
#else
valToStr value = toJSVal value >>= valueToString
#endif
valToText :: ToJSVal value => value -> JSM Text
valToText jsvar = strToText <$> valToStr jsvar
valToJSON :: ToJSVal value => value -> JSM JSString
#ifdef ghcjs_HOST_OS
valToJSON value = jsrefToJSON <$> toJSVal value
foreign import javascript unsafe "$r = $1 === undefined ? \"\" : JSON.stringify($1);" jsrefToJSON :: JSVal -> JSString
#else
valToJSON value = toJSVal value >>= valueToJSON
#endif
valToObject :: ToJSVal value => value -> JSM Object
valToObject value = Object <$> toJSVal value
instance MakeObject JSVal where
makeObject = return . Object
instance ToJSVal Object where
toJSVal (Object r) = return r
val :: ToJSVal value
=> value
-> JSM JSVal
val = toJSVal
#ifndef ghcjs_HOST_OS
instance ToJSVal JSVal where
toJSVal = return
#endif
instance MakeArgs JSVal where
makeArgs arg = return [arg]
instance ToJSVal v => ToJSVal (JSM v) where
toJSVal v = v >>= toJSVal
valNull :: JSVal
valNull = jsNull
instance ToJSVal JSNull where
toJSVal = const (return jsNull)
instance MakeArgs JSNull where
makeArgs _ = return [jsNull]
#ifndef ghcjs_HOST_OS
instance ToJSVal a => ToJSVal (Maybe a) where
toJSVal Nothing = return jsNull
toJSVal (Just a) = toJSVal a
instance FromJSVal a => FromJSVal (Maybe a) where
fromJSValUnchecked x =
ghcjsPure (isUndefined x) >>= \case
True -> return Nothing
False -> ghcjsPure (isNull x) >>= \case
True -> return Nothing
False -> fromJSVal x
fromJSVal x =
ghcjsPure (isUndefined x) >>= \case
True -> return (Just Nothing)
False -> ghcjsPure (isNull x) >>= \case
True -> return (Just Nothing)
False -> fmap (fmap Just) fromJSVal x
instance ToJSVal a => ToJSVal [a] where
toJSVal = toJSValListOf
instance FromJSVal a => FromJSVal [a] where
fromJSVal = fromJSValListOf
#endif
valIsNull :: ToJSVal value => value -> JSM Bool
valIsNull value = toJSVal value >>= ghcjsPure . isNull
valUndefined :: JSVal
valUndefined = jsUndefined
instance ToJSVal JSUndefined where
toJSVal = const (return jsUndefined)
instance MakeArgs () where
makeArgs _ = return []
valIsUndefined :: ToJSVal value => value -> JSM Bool
valIsUndefined value = toJSVal value >>= ghcjsPure . isUndefined
maybeNullOrUndefined :: ToJSVal value => value -> JSM (Maybe JSVal)
maybeNullOrUndefined value = do
rval <- toJSVal value
ghcjsPure (isNull rval) >>= \case
True -> return Nothing
_ ->
ghcjsPure (isUndefined rval) >>= \case
True -> return Nothing
_ -> return (Just rval)
maybeNullOrUndefined' :: ToJSVal value => (JSVal -> JSM a) -> value -> JSM (Maybe a)
maybeNullOrUndefined' f value = do
rval <- toJSVal value
ghcjsPure (isNull rval) >>= \case
True -> return Nothing
_ ->
ghcjsPure (isUndefined rval) >>= \case
True -> return Nothing
_ -> Just <$> f rval
valBool :: Bool -> JSVal
valBool = toJSBool
#ifndef ghcjs_HOST_OS
instance ToJSVal Bool where
toJSVal = return . valBool
#endif
instance MakeArgs Bool where
makeArgs b = return [valBool b]
valMakeNumber :: Double -> JSM JSVal
valMakeNumber = toJSVal
#ifndef ghcjs_HOST_OS
instance ToJSVal Double where
toJSVal = numberToValue
instance ToJSVal Float where
toJSVal = numberToValue . realToFrac
instance ToJSVal Word where
toJSVal = numberToValue . fromIntegral
instance ToJSVal Word8 where
toJSVal = numberToValue . fromIntegral
instance ToJSVal Word16 where
toJSVal = numberToValue . fromIntegral
instance ToJSVal Word32 where
toJSVal = numberToValue . fromIntegral
instance ToJSVal Int where
toJSVal = numberToValue . fromIntegral
instance ToJSVal Int8 where
toJSVal = numberToValue . fromIntegral
instance ToJSVal Int16 where
toJSVal = numberToValue . fromIntegral
instance ToJSVal Int32 where
toJSVal = numberToValue . fromIntegral
#endif
instance MakeArgs Double where
makeArgs n = valMakeNumber n >>= (\ref -> return [ref])
valMakeText :: Text -> JSM JSVal
valMakeText = toJSVal . textToJSString
valMakeString :: JSString -> JSM JSVal
valMakeString = toJSVal
#ifndef ghcjs_HOST_OS
instance ToJSVal Text where
toJSVal = stringToValue . JSString
instance FromJSVal Text where
fromJSValUnchecked = valToText
fromJSVal = fmap Just . valToText
#endif
instance MakeArgs Text where
makeArgs t = valMakeText t >>= (\ref -> return [ref])
#ifndef ghcjs_HOST_OS
instance ToJSVal JSString where
toJSVal = stringToValue
instance FromJSVal JSString where
fromJSValUnchecked = valToStr
fromJSVal = fmap Just . valToStr
#endif
instance ToJSString JSString where
toJSString = id
instance ToJSString Text where
toJSString = textToStr
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
toJSValListOf = valMakeText . T.pack
instance FromJSVal Char where
fromJSValUnchecked = fmap (chr . round) . valToNumber
fromJSVal = fmap (Just . chr . round) . valToNumber
fromJSValUncheckedListOf = fmap (T.unpack . strToText) . valToStr
fromJSValListOf = fmap (Just . T.unpack . strToText) . valToStr
#endif
valMakeJSON :: Value -> JSM JSVal
valMakeJSON = toJSVal
#ifndef ghcjs_HOST_OS
instance ToJSVal Value where
toJSVal = jsonValueToValue
#endif
instance MakeArgs Value where
makeArgs t = valMakeJSON t >>= (\ref -> return [ref])
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 "$r = ($1 === undefined)?0:\
($1===null)?1:\
(typeof $1===\"boolean\")?2:\
(typeof $1===\"number\")?3:\
(typeof $1===\"string\")?4:\
(typeof $1===\"object\")?5:-1;" jsrefGetType :: JSVal -> Int
#else
deRefVal value = do
v <- toJSVal value
result <- N.deRefVal v
return $ case result of
DeRefValResult 0 _ -> ValNull
DeRefValResult 1 _ -> ValUndefined
DeRefValResult 2 _ -> ValBool False
DeRefValResult 3 _ -> ValBool True
DeRefValResult (1) s -> ValNumber (read (T.unpack s))
DeRefValResult (2) s -> ValString s
DeRefValResult (3) _ -> ValObject (Object v)
_ -> error "Unexpected result dereferencing JSaddle value"
#endif
valMakeRef :: JSValue -> JSM JSVal
valMakeRef value =
case value of
ValNull -> return valNull
ValUndefined -> return valUndefined
ValBool b -> return $ valBool b
ValNumber n -> valMakeNumber n
ValString s -> valMakeText s
ValObject (Object o) -> return o
instance ToJSVal JSValue where
toJSVal = valMakeRef
instance MakeArgs JSValue where
makeArgs v = valMakeRef v >>= (\ref -> return [ref])
#ifdef ghcjs_HOST_OS
foreign import javascript unsafe
"$1===$2" jsvalueisstrictequal :: JSVal -> JSVal -> Bool
#endif
strictEqual :: (ToJSVal a, ToJSVal b) => a -> b -> JSM Bool
strictEqual a b = do
aval <- toJSVal a
bval <- toJSVal b
#ifdef ghcjs_HOST_OS
return $ jsvalueisstrictequal aval bval
#else
N.strictEqual aval bval
#endif
#ifdef ghcjs_HOST_OS
foreign import javascript unsafe "$1 instanceof $2"
js_isInstanceOf :: JSVal -> Object -> Bool
#endif
instanceOf :: (ToJSVal value, MakeObject constructor) => value -> constructor -> JSM Bool
instanceOf value constructor = do
v <- toJSVal value
c <- makeObject constructor
#ifdef ghcjs_HOST_OS
return $ js_isInstanceOf v c
#else
N.instanceOf v c
#endif