module GHCJS.Marshal ( FromJSVal(..)
, ToJSVal(..)
, toJSVal_aeson
, toJSVal_pure
) where
import Control.Monad
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import qualified Data.Aeson as AE
import qualified Data.HashMap.Strict as H
import Data.Int (Int8, Int16, Int32)
import qualified Data.JSString.Text as JSS
import Data.Scientific (Scientific, scientific, fromFloatDigits)
import Data.Text (Text)
import qualified Data.Vector as V
import Data.Word (Word8, Word16, Word32, Word)
import GHCJS.Types
import GHCJS.Foreign.Internal
import GHCJS.Marshal.Pure
import qualified JavaScript.Array.Internal as AI
import qualified JavaScript.Object.Internal as OI
import GHCJS.Marshal.Internal
instance FromJSVal JSVal where
fromJSValUnchecked x = return x
fromJSVal = return . Just
instance FromJSVal () where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal a => FromJSVal [a] where
fromJSVal = fromJSValListOf
instance FromJSVal a => FromJSVal (Maybe a) where
fromJSValUnchecked x | isUndefined x || isNull x = return Nothing
| otherwise = fromJSVal x
fromJSVal x | isUndefined x || isNull x = return (Just Nothing)
| otherwise = fmap (fmap Just) fromJSVal x
instance FromJSVal JSString where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Text where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Char where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
fromJSValUncheckedListOf = fromJSValUnchecked_pure
fromJSValListOf = fromJSVal_pure
instance FromJSVal Bool where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Int where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Int8 where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Int16 where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Int32 where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Word where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Word8 where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Word16 where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Word32 where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Float where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Double where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal AE.Value where
fromJSVal r = case jsonTypeOf r of
JSONNull -> return (Just AE.Null)
JSONInteger -> liftM (AE.Number . flip scientific 0 . (toInteger :: Int -> Integer))
<$> fromJSVal r
JSONFloat -> liftM (AE.Number . (fromFloatDigits :: Double -> Scientific))
<$> fromJSVal r
JSONBool -> liftM AE.Bool <$> fromJSVal r
JSONString -> liftM AE.String <$> fromJSVal r
JSONArray -> liftM (AE.Array . V.fromList) <$> fromJSVal r
JSONObject -> do
props <- OI.listProps (OI.Object r)
runMaybeT $ do
propVals <- forM props $ \p -> do
v <- MaybeT (fromJSVal =<< OI.getProp p (OI.Object r))
return (JSS.textFromJSString p, v)
return (AE.Object (H.fromList propVals))
instance (FromJSVal a, FromJSVal b) => FromJSVal (a,b) where
fromJSVal r = runMaybeT $ (,) <$> jf r 0 <*> jf r 1
instance (FromJSVal a, FromJSVal b, FromJSVal c) => FromJSVal (a,b,c) where
fromJSVal r = runMaybeT $ (,,) <$> jf r 0 <*> jf r 1 <*> jf r 2
instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d) => FromJSVal (a,b,c,d) where
fromJSVal r = runMaybeT $ (,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3
instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e) => FromJSVal (a,b,c,d,e) where
fromJSVal r = runMaybeT $ (,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4
instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e, FromJSVal f) => FromJSVal (a,b,c,d,e,f) where
fromJSVal r = runMaybeT $ (,,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4 <*> jf r 5
instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e, FromJSVal f, FromJSVal g) => FromJSVal (a,b,c,d,e,f,g) where
fromJSVal r = runMaybeT $ (,,,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4 <*> jf r 5 <*> jf r 6
instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e, FromJSVal f, FromJSVal g, FromJSVal h) => FromJSVal (a,b,c,d,e,f,g,h) where
fromJSVal r = runMaybeT $ (,,,,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4 <*> jf r 5 <*> jf r 6 <*> jf r 7
jf :: FromJSVal a => JSVal -> Int -> MaybeT IO a
jf r n = MaybeT $ do
r' <- AI.read n (AI.SomeJSArray r)
if isUndefined r
then return Nothing
else fromJSVal r'
instance ToJSVal JSVal where
toJSVal = toJSVal_pure
instance ToJSVal AE.Value where
toJSVal = toJSVal_aeson
instance ToJSVal JSString where
toJSVal = toJSVal_pure
instance ToJSVal Text where
toJSVal = toJSVal_pure
instance ToJSVal Char where
toJSVal = return . pToJSVal
toJSValListOf = return . pToJSVal
instance ToJSVal Bool where
toJSVal = toJSVal_pure
instance ToJSVal Int where
toJSVal = toJSVal_pure
instance ToJSVal Int8 where
toJSVal = toJSVal_pure
instance ToJSVal Int16 where
toJSVal = toJSVal_pure
instance ToJSVal Int32 where
toJSVal = toJSVal_pure
instance ToJSVal Word where
toJSVal = toJSVal_pure
instance ToJSVal Word8 where
toJSVal = toJSVal_pure
instance ToJSVal Word16 where
toJSVal = toJSVal_pure
instance ToJSVal Word32 where
toJSVal = toJSVal_pure
instance ToJSVal Float where
toJSVal = toJSVal_pure
instance ToJSVal Double where
toJSVal = toJSVal_pure
instance ToJSVal a => ToJSVal [a] where
toJSVal = toJSValListOf
instance ToJSVal a => ToJSVal (Maybe a) where
toJSVal Nothing = return jsNull
toJSVal (Just a) = toJSVal a
instance (ToJSVal a, ToJSVal b) => ToJSVal (a,b) where
toJSVal _ = pure nullRef
instance (ToJSVal a, ToJSVal b, ToJSVal c) => ToJSVal (a,b,c) where
toJSVal _ = pure nullRef
instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d) => ToJSVal (a,b,c,d) where
toJSVal _ = pure nullRef
instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e) => ToJSVal (a,b,c,d,e) where
toJSVal _ = pure nullRef
instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e, ToJSVal f) => ToJSVal (a,b,c,d,e,f) where
toJSVal _ = pure nullRef
instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e, ToJSVal f, ToJSVal g) => ToJSVal (a,b,c,d,e,f,g) where
toJSVal _ = pure nullRef
toJSVal_aeson :: AE.ToJSON a => a -> IO JSVal
toJSVal_aeson x = cv (AE.toJSON x)
where
cv = convertValue
convertValue :: AE.Value -> IO JSVal
convertValue AE.Null = return jsNull
convertValue (AE.String t) = return (pToJSVal t)
convertValue (AE.Array a) = (\(AI.SomeJSArray x') -> x') <$>
(AI.fromListIO =<< mapM convertValue (V.toList a))
convertValue (AE.Number n) = toJSVal (realToFrac n :: Double)
convertValue (AE.Bool b) = return (toJSBool b)
convertValue (AE.Object o) = do
obj@(OI.Object obj') <- OI.create
mapM_ (\(k,v) -> convertValue v >>= \v' -> OI.setProp (JSS.textToJSString k) v' obj) (H.toList o)
return obj'