{-|
  Description:
    Constructing and manipulating javascript objects
-}
{-# Language ConstraintKinds #-}
module JSDOM.Extras.Object where

import Control.Monad
import Language.Javascript.JSaddle

type ToJSObject k v = (ToJSString k, ToJSVal v)

-- | Turn a single key, value pair into a javascript object
singleton
  :: (ToJSObject a b, MonadJSM m)
  => a
  -> b
  -> m Object
singleton :: forall a b (m :: * -> *).
(ToJSObject a b, MonadJSM m) =>
a -> b -> m Object
singleton a
k b
v = [(a, b)] -> m Object
forall (m :: * -> *) a b.
(MonadJSM m, ToJSObject a b) =>
[(a, b)] -> m Object
toObject [(a
k, b
v)]

-- | Turn a set of key, value pairs into a javascript object
toObject
  :: (MonadJSM m, ToJSObject a b)
  => [(a, b)]
  -> m Object
toObject :: forall (m :: * -> *) a b.
(MonadJSM m, ToJSObject a b) =>
[(a, b)] -> m Object
toObject [(a, b)]
args = JSM Object -> m Object
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM Object -> m Object) -> JSM Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
  Object
o <- JSM Object
create
  let mk :: (a, a) -> JSM ()
mk (a
k, a
v) = do
        JSVal
v' <- a -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal a
v
        JSString -> JSVal -> Object -> JSM ()
setProp (a -> JSString
forall a. ToJSString a => a -> JSString
toJSString a
k) JSVal
v' Object
o
  ((a, b) -> JSM ()) -> [(a, b)] -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a, b) -> JSM ()
forall {a} {a}. (ToJSString a, ToJSVal a) => (a, a) -> JSM ()
mk [(a, b)]
args
  Object -> JSM Object
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
o

-- | Turns a javascript Object into a list of keys and values
fromObject
  :: MonadJSM m
  => Object
  -> m [(JSString, JSVal)]
fromObject :: forall (m :: * -> *). MonadJSM m => Object -> m [(JSString, JSVal)]
fromObject Object
o = JSM [(JSString, JSVal)] -> m [(JSString, JSVal)]
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM [(JSString, JSVal)] -> m [(JSString, JSVal)])
-> JSM [(JSString, JSVal)] -> m [(JSString, JSVal)]
forall a b. (a -> b) -> a -> b
$ do
  [JSString]
keys <- Object -> JSM [JSString]
listProps Object
o
  [JSString]
-> (JSString -> JSM (JSString, JSVal)) -> JSM [(JSString, JSVal)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [JSString]
keys ((JSString -> JSM (JSString, JSVal)) -> JSM [(JSString, JSVal)])
-> (JSString -> JSM (JSString, JSVal)) -> JSM [(JSString, JSVal)]
forall a b. (a -> b) -> a -> b
$ \JSString
k -> do
    JSVal
v <- JSString -> Object -> JSM JSVal
unsafeGetProp JSString
k Object
o
    (JSString, JSVal) -> JSM (JSString, JSVal)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSString
k, JSVal
v)

-- | A function that does nothing
doNothing :: JSCallAsFunction
doNothing :: JSCallAsFunction
doNothing = JSCallAsFunction -> JSCallAsFunction
fun (JSCallAsFunction -> JSCallAsFunction)
-> JSCallAsFunction -> JSCallAsFunction
forall a b. (a -> b) -> a -> b
$ \JSVal
_ JSVal
_ [JSVal]
_ -> () -> JSM ()
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Lookup a key in an object. Treats both @null@s and @undefined@s as
-- 'Nothing'
lookup
  :: MonadJSM m
  => JSString
  -> Object
  -> m (Maybe JSVal)
lookup :: forall (m :: * -> *).
MonadJSM m =>
JSString -> Object -> m (Maybe JSVal)
lookup JSString
k Object
o = JSM (Maybe JSVal) -> m (Maybe JSVal)
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (Maybe JSVal) -> m (Maybe JSVal))
-> JSM (Maybe JSVal) -> m (Maybe JSVal)
forall a b. (a -> b) -> a -> b
$ JSVal -> JSM (Maybe JSVal)
forall (m :: * -> *). MonadJSM m => JSVal -> m (Maybe JSVal)
toMaybe (JSVal -> JSM (Maybe JSVal)) -> JSM JSVal -> JSM (Maybe JSVal)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSString -> Object -> JSM JSVal
getProp JSString
k Object
o

-- | Wraps a javascript value in 'Maybe', treating @undefined@ and @null@ as
-- 'Nothing'
toMaybe :: MonadJSM m => JSVal -> m (Maybe JSVal)
toMaybe :: forall (m :: * -> *). MonadJSM m => JSVal -> m (Maybe JSVal)
toMaybe JSVal
a = JSM (Maybe JSVal) -> m (Maybe JSVal)
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (Maybe JSVal) -> m (Maybe JSVal))
-> JSM (Maybe JSVal) -> m (Maybe JSVal)
forall a b. (a -> b) -> a -> b
$ do
  Bool
resultIsUndefined <- JSVal -> JSM Bool
forall value. ToJSVal value => value -> JSM Bool
valIsUndefined JSVal
a
  Bool
resultIsNull <- JSVal -> JSM Bool
forall value. ToJSVal value => value -> JSM Bool
valIsNull JSVal
a
  Maybe JSVal -> JSM (Maybe JSVal)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe JSVal -> JSM (Maybe JSVal))
-> Maybe JSVal -> JSM (Maybe JSVal)
forall a b. (a -> b) -> a -> b
$ if Bool
resultIsUndefined Bool -> Bool -> Bool
|| Bool
resultIsNull then Maybe JSVal
forall a. Maybe a
Nothing else JSVal -> Maybe JSVal
forall a. a -> Maybe a
Just JSVal
a