content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MagicHash #-}
  {-# LANGUAGE UnboxedTuples #-}
  -----------------------------------------------------------------------------
  --
  -- 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
    , setPropertyByName
    , setPropertyAtIndex
    , stringToValue
    , numberToValue
    , jsonValueToValue
    , getPropertyByName
    , getPropertyAtIndex
    , callAsFunction
    , callAsConstructor
    , newEmptyObject
    , newAsyncCallback
    , newSyncCallback
    , newArray
    , evaluateScript
    , deRefVal
    , valueToBool
    , valueToNumber
    , valueToString
    , valueToJSON
    , valueToJSONValue
    , isNull
    , isUndefined
    , strictEqual
    , instanceOf
    , propertyNames
  ) where
  
  import Control.Monad.IO.Class (MonadIO(..))
  
  import Data.Aeson (Value)
  
  import Language.Javascript.JSaddle.Types
         (AsyncCommand(..), JSM(..), JSString(..), addCallback,
          Object(..), JSVal(..), JSValueForSend(..), JSCallAsFunction,
          JSStringReceived(..), JSStringForSend(..), JSObjectForSend(..))
  import Language.Javascript.JSaddle.Monad (askJSM)
  import Language.Javascript.JSaddle.Run
         (Command(..), Result(..), sendCommand,
          sendAsyncCommand, sendLazyCommand, wrapJSVal)
  import GHC.IORef (IORef(..), readIORef)
  import GHC.STRef (STRef(..))
  import GHC.IO (IO(..))
  import GHC.Base (touch#)
  
  wrapJSString :: MonadIO m => JSStringReceived -> m JSString
  wrapJSString (JSStringReceived ref) = return $ JSString ref
  
  touchIORef :: IORef a -> IO ()
  touchIORef (IORef (STRef r#)) = IO $ \s -> case touch# r# s of s' -> (# s', () #)
  
  withJSVal :: MonadIO m => JSVal -> (JSValueForSend -> m a) -> m a
  withJSVal (JSVal ref) f = do
      result <- (f . JSValueForSend) =<< liftIO (readIORef ref)
      liftIO $ touchIORef ref
      return result
  
  withJSVals :: MonadIO m => [JSVal] -> ([JSValueForSend] -> m a) -> m a
  withJSVals v f =
   do result <- f =<< mapM (\(JSVal ref) -> liftIO $ JSValueForSend <$> readIORef ref) v
      liftIO $ mapM_ (\(JSVal ref) -> touchIORef ref) 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 (JSString ref) f = f (JSStringForSend ref)
  
  setPropertyByName :: JSString -> JSVal -> Object -> JSM ()
  setPropertyByName name val this =
      withObject this $ \rthis ->
          withJSString name $ \rname ->
              withJSVal val $ \rval ->
                  sendAsyncCommand $ SetPropertyByName rthis rname rval
  {-# INLINE setPropertyByName #-}
  
  setPropertyAtIndex :: Int -> JSVal -> Object -> JSM ()
  setPropertyAtIndex index val this =
      withObject this $ \rthis ->
          withJSVal val $ \rval ->
              sendAsyncCommand $ SetPropertyAtIndex rthis index rval
  {-# INLINE setPropertyAtIndex #-}
  
  stringToValue :: JSString -> JSM JSVal
  stringToValue s = withJSString s $ sendLazyCommand . StringToValue
  {-# INLINE stringToValue #-}
  
  numberToValue :: Double -> JSM JSVal
  numberToValue = sendLazyCommand . NumberToValue
  {-# INLINE numberToValue #-}
  
  jsonValueToValue :: Value -> JSM JSVal
  jsonValueToValue = sendLazyCommand . JSONValueToValue
  {-# INLINE jsonValueToValue #-}
  
  getPropertyByName :: JSString -> Object -> JSM JSVal
  getPropertyByName name this =
      withObject this $ \rthis ->
          withJSString name $ sendLazyCommand . GetPropertyByName rthis
  {-# INLINE getPropertyByName #-}
  
  getPropertyAtIndex :: Int -> Object -> JSM JSVal
  getPropertyAtIndex index this =
      withObject this $ \rthis -> sendLazyCommand $ GetPropertyAtIndex rthis index
  {-# INLINE getPropertyAtIndex #-}
  
  callAsFunction :: Object -> Object -> [JSVal] -> JSM JSVal
  callAsFunction f this args =
      withObject f $ \rfunction ->
          withObject this $ \rthis ->
              withJSVals args $ sendLazyCommand . CallAsFunction rfunction rthis
  {-# INLINE callAsFunction #-}
  
  callAsConstructor :: Object -> [JSVal] -> JSM JSVal
  callAsConstructor f args =
      withObject f $ \rfunction ->
          withJSVals args $ sendLazyCommand . CallAsConstructor rfunction
  {-# INLINE callAsConstructor #-}
  
  newEmptyObject :: JSM Object
  newEmptyObject = Object <$> sendLazyCommand NewEmptyObject
  {-# INLINE newEmptyObject #-}
  
  newAsyncCallback :: JSCallAsFunction -> JSM Object
  newAsyncCallback f = do
      object <- Object <$> sendLazyCommand NewAsyncCallback
      add <- addCallback <$> askJSM
      liftIO $ add object f
      return object
  {-# INLINE newAsyncCallback #-}
  
  newSyncCallback :: JSCallAsFunction -> JSM Object
  newSyncCallback f = do
      object <- Object <$> sendLazyCommand NewSyncCallback
      add <- addCallback <$> askJSM
      liftIO $ add object f
      return object
  {-# INLINE newSyncCallback #-}
  
  newArray :: [JSVal] -> JSM JSVal
  newArray xs = withJSVals xs $ \xs' -> sendLazyCommand (NewArray xs')
  {-# INLINE newArray #-}
  
  evaluateScript :: JSString -> JSM JSVal
  evaluateScript script = withJSString script $ sendLazyCommand . EvaluateScript
  {-# INLINE evaluateScript #-}
  
  deRefVal :: JSVal -> JSM Result
  deRefVal value = withJSVal value $ sendCommand . DeRefVal
  {-# INLINE deRefVal #-}
  
  valueToBool :: JSVal -> JSM Bool
  valueToBool v@(JSVal ref) = liftIO (readIORef ref) >>= \case
      0 -> return False -- null
      1 -> return False -- undefined
      2 -> return False -- false
      3 -> return True  -- true
      _ -> withJSVal v $ \rval -> do
          (ValueToBoolResult result) <- sendCommand (ValueToBool rval)
          return result
  {-# INLINE valueToBool #-}
  
  valueToNumber :: JSVal -> JSM Double
  valueToNumber value =
      withJSVal value $ \rval -> do
          (ValueToNumberResult result) <- sendCommand (ValueToNumber rval)
          return result
  {-# INLINE valueToNumber #-}
  
  valueToString :: JSVal -> JSM JSString
  valueToString value = withJSVal value $ \rval -> do
      (ValueToStringResult result) <- sendCommand (ValueToString rval)
      wrapJSString result
  {-# INLINE valueToString #-}
  
  valueToJSON :: JSVal -> JSM JSString
  valueToJSON value = withJSVal value $ \rval -> do
      (ValueToJSONResult result) <- sendCommand (ValueToJSON rval)
      wrapJSString result
  {-# INLINE valueToJSON #-}
  
  valueToJSONValue :: JSVal -> JSM Value
  valueToJSONValue value = withJSVal value $ \rval -> do
      (ValueToJSONValueResult result) <- sendCommand (ValueToJSONValue rval)
      return result
  {-# INLINE valueToJSONValue #-}
  
  isNull :: JSVal -> JSM Bool
  isNull v@(JSVal ref) = liftIO (readIORef ref) >>= \case
      0 -> return True  -- null
      1 -> return False -- undefined
      2 -> return False -- false
      3 -> return False -- true
      _ -> withJSVal v $ \rval -> do
          (IsNullResult result) <- sendCommand $ IsNull rval
          return result
  {-# INLINE isNull #-}
  
  isUndefined :: JSVal -> JSM Bool
  isUndefined v@(JSVal ref) = liftIO (readIORef ref) >>= \case
      0 -> return False -- null
      1 -> return True  -- undefined
      2 -> return False -- false
      3 -> return False -- true
      _ -> withJSVal v $ \rval -> do
          (IsUndefinedResult result) <- sendCommand $ IsUndefined rval
          return result
  {-# INLINE isUndefined #-}
  
  strictEqual :: JSVal -> JSVal -> JSM Bool
  strictEqual a b =
      withJSVal a $ \aref ->
          withJSVal b $ \bref -> do
              (StrictEqualResult result) <- sendCommand $ StrictEqual aref bref
              return result
  {-# INLINE strictEqual #-}
  
  instanceOf :: JSVal -> Object -> JSM Bool
  instanceOf value constructor =
      withJSVal value $ \rval ->
          withObject constructor $ \c' -> do
              (InstanceOfResult result) <- sendCommand $ InstanceOf rval c'
              return result
  {-# INLINE instanceOf #-}
  
  propertyNames :: Object -> JSM [JSString]
  propertyNames this =
      withObject this $ \rthis -> do
          (PropertyNamesResult result) <- sendCommand $ PropertyNames rthis
          mapM wrapJSString result
  {-# INLINE propertyNames #-}
  