#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
#endif
module Language.Javascript.JSaddle.Value (
JSValueRef
, MakeValueRef(..)
, JSNull(..)
, JSUndefined(..)
, JSBool(..)
, JSNumber(..)
, JSString(..)
, JSValue(..)
, valToBool
, valToNumber
, valToStr
, valToObject
, valToText
, valToJSON
, val
, valMakeNull
, valMakeUndefined
, valMakeBool
, valMakeNumber
, valMakeString
, deRefVal
, valMakeRef
) where
import Prelude hiding (catch)
import Language.Javascript.JSaddle.Types
(JSValueRefRef, JSObjectRef, JSStringRef, JSValueRef)
#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
import GHCJS.Types (castRef, JSRef(..))
import GHCJS.Foreign (toJSBool, fromJSBool', jsNull, jsUndefined, toJSString)
import GHCJS.Marshal (toJSRef)
#else
import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
(jsvaluecreatejsonstring, JSType(..), jsvaluegettype,
jsvaluemakestring, jsvaluemakenumber, jsvaluemakeboolean,
jsvaluemakeundefined, jsvaluemakenull, jsvaluetoobject,
jsvaluetostringcopy, jsvaluetonumber, jsvaluetoboolean)
import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef
(jsstringgetcharactersptr, jsstringgetlength)
#endif
import Language.Javascript.JSaddle.Monad (JSM, catchval)
import Language.Javascript.JSaddle.Exception (rethrow)
import Control.Monad.Trans.Reader (ask)
import Control.Monad.IO.Class (MonadIO, MonadIO(..))
import qualified Data.Text.Foreign as T (fromPtr)
import Foreign (castPtr)
import Data.Text.Foreign (useAsPtr)
import Control.Applicative ((<$>))
import Data.Text (Text)
import qualified Data.Text as T (pack)
import Language.Javascript.JSaddle.Classes
(MakeObjectRef(..), MakeStringRef(..), MakeValueRef(..),
MakeArgRefs(..))
import Language.Javascript.JSaddle.String (strToText, textToStr)
import Language.Javascript.JSaddle.Arguments ()
import Data.Word (Word)
data JSNull = JSNull
type JSUndefined = ()
type JSBool = Bool
type JSNumber = Double
type JSString = Text
data JSValue = ValNull
| ValUndefined
| ValBool JSBool
| ValNumber JSNumber
| ValString JSString
| ValObject JSObjectRef
deriving(Show, Eq)
valToBool :: MakeValueRef val => val -> JSM JSBool
#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
valToBool val = fromJSBool' <$> makeValueRef val
#else
valToBool val = do
gctxt <- ask
rval <- makeValueRef val
liftIO $ jsvaluetoboolean gctxt rval
#endif
valToNumber :: MakeValueRef val => val -> JSM JSNumber
#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
valToNumber val = jsrefToNumber <$> makeValueRef val
foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSRef a -> Double
#elif defined(USE_WEBKIT)
valToNumber val = do
gctxt <- ask
rval <- makeValueRef val
rethrow $ liftIO . jsvaluetonumber gctxt rval
#else
valToNumber = undefined
#endif
valToStr :: MakeValueRef val => val -> JSM JSStringRef
#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
valToStr val = jsrefToString <$> makeValueRef val
foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSRef a -> JSStringRef
#elif defined(USE_WEBKIT)
valToStr val = do
gctxt <- ask
rval <- makeValueRef val
rethrow $ liftIO . jsvaluetostringcopy gctxt rval
#else
valToStr = undefined
#endif
valToText :: MakeValueRef val => val -> JSM Text
valToText jsvar = valToStr jsvar >>= strToText
valToJSON :: MakeValueRef val => Word -> val -> JSM JSStringRef
#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
valToJSON indent val = jsrefToJSON <$> makeValueRef val
foreign import javascript unsafe "$r = JSON.stringify($1);" jsrefToJSON :: JSRef a -> JSStringRef
#elif defined(USE_WEBKIT)
valToJSON indent val = do
gctxt <- ask
rval <- makeValueRef val
rethrow $ liftIO . jsvaluecreatejsonstring gctxt rval (fromIntegral indent)
#else
valToJSON = undefined
#endif
valToObject :: MakeValueRef val => val -> JSM JSObjectRef
#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
valToObject val = castRef <$> makeValueRef val
#else
valToObject val = do
gctxt <- ask
rval <- makeValueRef val
rethrow $ liftIO . jsvaluetoobject gctxt rval
#endif
val :: MakeValueRef value
=> value
-> JSM JSValueRef
val = makeValueRef
instance MakeValueRef JSValueRef where
makeValueRef = return
instance MakeArgRefs JSValueRef where
makeArgRefs arg = return [arg]
instance MakeValueRef v => MakeValueRef (JSM v) where
makeValueRef v = v >>= makeValueRef
valMakeNull :: JSM JSValueRef
#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
valMakeNull = return jsNull
#else
valMakeNull = ask >>= (liftIO . jsvaluemakenull)
#endif
instance MakeValueRef JSNull where
makeValueRef = const valMakeNull
instance MakeArgRefs JSNull where
makeArgRefs _ = valMakeNull >>= (\ref -> return [ref])
valMakeUndefined :: JSM JSValueRef
#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
valMakeUndefined = return jsUndefined
#else
valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)
#endif
instance MakeValueRef JSUndefined where
makeValueRef = const valMakeUndefined
instance MakeArgRefs () where
makeArgRefs _ = return []
valMakeBool :: JSBool -> JSM JSValueRef
#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
valMakeBool b = return . castRef $ toJSBool b
#else
valMakeBool b = do
gctxt <- ask
liftIO $ jsvaluemakeboolean gctxt b
#endif
instance MakeValueRef Bool where
makeValueRef = valMakeBool
instance MakeArgRefs Bool where
makeArgRefs b = valMakeBool b >>= (\ref -> return [ref])
valMakeNumber :: JSNumber -> JSM JSValueRef
#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
valMakeNumber n = liftIO $ castRef <$> toJSRef n
#else
valMakeNumber n = do
gctxt <- ask
liftIO $ jsvaluemakenumber gctxt n
#endif
instance MakeValueRef Double where
makeValueRef = valMakeNumber
instance MakeArgRefs Double where
makeArgRefs n = valMakeNumber n >>= (\ref -> return [ref])
valMakeString :: Text -> JSM JSValueRef
#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
valMakeString = return . castRef . toJSString
#else
valMakeString text = do
gctxt <- ask
liftIO $ jsvaluemakestring gctxt (textToStr text)
#endif
instance MakeValueRef Text where
makeValueRef = valMakeString
instance MakeArgRefs Text where
makeArgRefs t = valMakeString t >>= (\ref -> return [ref])
instance MakeValueRef String where
makeValueRef = valMakeString . T.pack
deRefVal :: MakeValueRef val => val -> JSM JSValue
#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
deRefVal val = do
gctxt <- ask
valref <- makeValueRef val
case (jsrefGetType valref :: Int) of
0 -> return ValUndefined
1 -> return ValNull
2 -> ValBool <$> valToBool valref
3 -> ValNumber <$> valToNumber valref
4 -> ValString <$> (valToStr valref >>= strToText)
5 -> ValObject <$> valToObject valref
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 :: JSValueRef -> Int
#elif defined(USE_WEBKIT)
deRefVal val = do
gctxt <- ask
valref <- makeValueRef val
t <- liftIO $ jsvaluegettype gctxt valref
case t of
Kjstypenull -> return ValNull
Kjstypeundefined -> return ValUndefined
Kjstypeboolean -> ValBool <$> valToBool valref
Kjstypenumber -> ValNumber <$> valToNumber valref
Kjstypestring -> ValString <$> (valToStr valref >>= strToText)
Kjstypeobject -> ValObject <$> valToObject valref
#else
deRefVal = undefined
#endif
valMakeRef :: JSValue -> JSM JSValueRef
valMakeRef val =
case val of
ValNull -> valMakeNull
ValUndefined -> valMakeUndefined
ValBool b -> valMakeBool b
ValNumber n -> valMakeNumber n
ValString s -> valMakeString s
ValObject o -> return o
instance MakeValueRef JSValue where
makeValueRef = valMakeRef
instance MakeArgRefs JSValue where
makeArgRefs v = valMakeRef v >>= (\ref -> return [ref])
instance MakeObjectRef JSNull where
makeObjectRef = const valMakeNull