-----------------------------------------------------------------------------
--
-- 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