{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE TupleSections #-}
module JavaScript.Extras.Property
( classNames
, Property
, getProperty
, setProperty
, fromProperties
, toProperties
) where
import Control.DeepSeq
import Control.Parallel
import qualified Data.JSString as JS
import qualified GHC.Exts as Exts
import qualified GHCJS.Marshal.Pure as J
import qualified GHCJS.Types as J
import qualified JavaScript.Extras.Cast as JE
import qualified JavaScript.Extras.JSRep as JE
import qualified JavaScript.Object as JO
import qualified JavaScript.Object.Internal as JOI
import Unsafe.Coerce
type Property = (J.JSString, JE.JSRep)
classNames :: [(J.JSString, Bool)] -> JE.JSRep
classNames = JE.toJSR . JS.unwords . fmap fst . filter snd
getProperty :: JE.ToJS a => a -> J.JSString -> IO JE.JSRep
getProperty a k = let k' = J.pToJSVal k
x = JE.toJS a
in if J.isUndefined x || J.isNull x
|| J.isUndefined k' || J.isNull k'
then pure $ JE.JSRep J.nullRef
else js_unsafeGetProperty x k
setProperty :: JE.ToJS a => a -> Property -> IO ()
setProperty a (k, v) = let k' = J.pToJSVal k
x = JE.toJS a
in if J.isUndefined x || J.isNull x
|| J.isUndefined k' || J.isNull k'
then pure ()
else js_unsafeSetProperty x k v
fromProperties :: [Property] -> JO.Object
fromProperties xs =
let (names, values) = unzip xs
in (rnf names `seq` rnf values) `pseq` js_toJSObjectPure (unsafeCoerce names) (unsafeCoerce values)
toProperties :: JO.Object -> IO [Property]
toProperties obj = do
props <- JO.listProps obj
traverse (\k -> (\v -> (k, JE.JSRep v)) <$> JO.unsafeGetProp k obj) props
#ifdef __GHCJS__
foreign import javascript unsafe
"$1[$2]"
js_unsafeGetProperty :: J.JSVal -> J.JSString -> IO JE.JSRep
foreign import javascript unsafe
"$1[$2] = $3;"
js_unsafeSetProperty :: J.JSVal -> J.JSString -> JE.JSRep -> IO ()
foreign import javascript unsafe
"hje$fromHsZipListJSVal($1, $2)"
js_toJSObjectPure :: Exts.Any -> Exts.Any -> JO.Object
#else
js_unsafeGetProperty :: J.JSVal -> J.JSString -> IO JE.JSRep
js_unsafeGetProperty _ _ = pure $ JE.JSRep J.nullRef
js_unsafeSetProperty :: J.JSVal -> J.JSString -> JE.JSRep -> IO ()
js_unsafeSetProperty _ _ _ = pure ()
js_toJSObjectPure :: Exts.Any -> Exts.Any -> JO.Object
js_toJSObjectPure _ _ = JOI.Object J.nullRef
#endif