module GHCJS.Marshal ( FromJSVal(..)
, ToJSVal(..)
, toJSVal_aeson
, toJSVal_pure
) where
import Control.Monad (join)
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import qualified Data.Aeson as AE
import Data.Int (Int8, Int16, Int32)
import Data.Word (Word8, Word16, Word32, Word)
import GHC.Prim
import Language.Javascript.JSaddle.Types (JSM, JSVal, SomeJSArray(..), Command(ValueToJSONValue), Result(ValueToJSONValueResult))
import Language.Javascript.JSaddle.Native (withToJSVal)
import Language.Javascript.JSaddle.Run(sendCommand)
import GHCJS.Marshal.Internal
import GHCJS.Marshal.Pure ()
import Language.Javascript.JSaddle.Value (isUndefinedIO, valToNumber,
valToBool, valMakeJSON)
import Language.Javascript.JSaddle.Array (fromListIO)
import qualified Language.Javascript.JSaddle.Array as A (read)
instance FromJSVal JSVal where
fromJSValUnchecked x = return x
fromJSVal = return . Just
instance FromJSVal () where
fromJSValUnchecked = fromJSValUnchecked_pure
fromJSVal = fromJSVal_pure
instance FromJSVal Bool where
fromJSValUnchecked = valToBool
fromJSVal = fmap Just . valToBool
instance FromJSVal Int where
fromJSValUnchecked = fmap round . valToNumber
fromJSVal = fmap (Just . round) . valToNumber
instance FromJSVal Int8 where
fromJSValUnchecked = fmap round . valToNumber
fromJSVal = fmap (Just . round) . valToNumber
instance FromJSVal Int16 where
fromJSValUnchecked = fmap round . valToNumber
fromJSVal = fmap (Just . round) . valToNumber
instance FromJSVal Int32 where
fromJSValUnchecked = fmap round . valToNumber
fromJSVal = fmap (Just . round) . valToNumber
instance FromJSVal Word where
fromJSValUnchecked = fmap round . valToNumber
fromJSVal = fmap (Just . round) . valToNumber
instance FromJSVal Word8 where
fromJSValUnchecked = fmap round . valToNumber
fromJSVal = fmap (Just . round) . valToNumber
instance FromJSVal Word16 where
fromJSValUnchecked = fmap round . valToNumber
fromJSVal = fmap (Just . round) . valToNumber
instance FromJSVal Word32 where
fromJSValUnchecked = fmap round . valToNumber
fromJSVal = fmap (Just . round) . valToNumber
instance FromJSVal Float where
fromJSValUnchecked = fmap realToFrac . valToNumber
fromJSVal = fmap (Just . realToFrac) . valToNumber
instance FromJSVal Double where
fromJSValUnchecked = valToNumber
fromJSVal = fmap Just . valToNumber
instance FromJSVal AE.Value where
fromJSVal r =
withToJSVal r $ \rval -> do
ValueToJSONValueResult result <- sendCommand (ValueToJSONValue rval)
return $ Just result
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 JSM a
jf r n = MaybeT $ do
r' <- A.read n (SomeJSArray r)
isUndefinedIO r >>= \case
True -> return Nothing
False -> fromJSVal r'
instance (ToJSVal a, ToJSVal b) => ToJSVal (a,b) where
toJSVal (a,b) = join $ arr2 <$> toJSVal a <*> toJSVal b
instance (ToJSVal a, ToJSVal b, ToJSVal c) => ToJSVal (a,b,c) where
toJSVal (a,b,c) = join $ arr3 <$> toJSVal a <*> toJSVal b <*> toJSVal c
instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d) => ToJSVal (a,b,c,d) where
toJSVal (a,b,c,d) = join $ arr4 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d
instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e) => ToJSVal (a,b,c,d,e) where
toJSVal (a,b,c,d,e) = join $ arr5 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d <*> toJSVal e
instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e, ToJSVal f) => ToJSVal (a,b,c,d,e,f) where
toJSVal (a,b,c,d,e,f) = join $ arr6 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d <*> toJSVal e <*> toJSVal f
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 (a,b,c,d,e,f,g) = join $ arr7 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d <*> toJSVal e <*> toJSVal f <*> toJSVal g
arr2 :: JSVal -> JSVal -> JSM JSVal
arr2 a b = coerce <$> fromListIO [a,b]
arr3 :: JSVal -> JSVal -> JSVal -> JSM JSVal
arr3 a b c = coerce <$> fromListIO [a,b,c]
arr4 :: JSVal -> JSVal -> JSVal -> JSVal -> JSM JSVal
arr4 a b c d = coerce <$> fromListIO [a,b,c,d]
arr5 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSM JSVal
arr5 a b c d e = coerce <$> fromListIO [a,b,c,d,e]
arr6 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSM JSVal
arr6 a b c d e f = coerce <$> fromListIO [a,b,c,d,e,f]
arr7 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSM JSVal
arr7 a b c d e f g = coerce <$> fromListIO [a,b,c,d,e,f,g]
toJSVal_aeson :: AE.ToJSON a => a -> JSM JSVal
toJSVal_aeson = valMakeJSON . AE.toJSON