{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, DefaultSignatures,
             TypeOperators, TupleSections, FlexibleContexts, FlexibleInstances,
             LambdaCase
  #-}

module GHCJS.Marshal.Internal ( FromJSVal(..)
                              , ToJSVal(..)
                              , PToJSVal(..)
                              , PFromJSVal(..)
                              , Purity(..)
                              , toJSVal_generic
                              , fromJSVal_generic
                              , toJSVal_pure
                              , fromJSVal_pure
                              , fromJSValUnchecked_pure
                              ) where

import           Control.Applicative
import           Control.Monad

import           Data.Data
import           Data.Maybe
import           Data.Coerce (coerce)
import qualified Data.Text as T (pack)

import           GHC.Generics

import qualified GHCJS.Prim.Internal        as Prim
import qualified GHCJS.Foreign.Internal     as F
import           GHCJS.Types

import qualified Data.JSString.Internal.Type as JSS

import qualified JavaScript.Object.Internal as OI (Object(..), create, setProp, getProp)
import qualified JavaScript.Array.Internal as AI (SomeJSArray(..), create, push, read, fromListIO, toListIO)

import           Language.Javascript.JSaddle.Types (JSM, MutableJSArray, GHCJSPure(..), ghcjsPure, ghcjsPureMap, JSadddleHasCallStack)
import           Language.Javascript.JSaddle.String (textToStr)

data Purity = PureShared    -- ^ conversion is pure even if the original value is shared
            | PureExclusive -- ^ conversion is pure if the we only convert once
  deriving (Purity -> Purity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Purity -> Purity -> Bool
$c/= :: Purity -> Purity -> Bool
== :: Purity -> Purity -> Bool
$c== :: Purity -> Purity -> Bool
Eq, Eq Purity
Purity -> Purity -> Bool
Purity -> Purity -> Ordering
Purity -> Purity -> Purity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Purity -> Purity -> Purity
$cmin :: Purity -> Purity -> Purity
max :: Purity -> Purity -> Purity
$cmax :: Purity -> Purity -> Purity
>= :: Purity -> Purity -> Bool
$c>= :: Purity -> Purity -> Bool
> :: Purity -> Purity -> Bool
$c> :: Purity -> Purity -> Bool
<= :: Purity -> Purity -> Bool
$c<= :: Purity -> Purity -> Bool
< :: Purity -> Purity -> Bool
$c< :: Purity -> Purity -> Bool
compare :: Purity -> Purity -> Ordering
$ccompare :: Purity -> Purity -> Ordering
Ord, Typeable, Typeable Purity
Purity -> DataType
Purity -> Constr
(forall b. Data b => b -> b) -> Purity -> Purity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Purity -> u
forall u. (forall d. Data d => d -> u) -> Purity -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Purity -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Purity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Purity -> m Purity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Purity -> m Purity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Purity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Purity -> c Purity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Purity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Purity)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Purity -> m Purity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Purity -> m Purity
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Purity -> m Purity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Purity -> m Purity
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Purity -> m Purity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Purity -> m Purity
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Purity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Purity -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Purity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Purity -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Purity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Purity -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Purity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Purity -> r
gmapT :: (forall b. Data b => b -> b) -> Purity -> Purity
$cgmapT :: (forall b. Data b => b -> b) -> Purity -> Purity
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Purity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Purity)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Purity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Purity)
dataTypeOf :: Purity -> DataType
$cdataTypeOf :: Purity -> DataType
toConstr :: Purity -> Constr
$ctoConstr :: Purity -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Purity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Purity
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Purity -> c Purity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Purity -> c Purity
Data)

class PToJSVal a where
--  type PureOut a :: Purity
  pToJSVal :: a -> JSVal

class PFromJSVal a where
--  type PureIn a :: Purity
  pFromJSVal :: JSVal -> a

class ToJSVal a where
  toJSVal :: a -> JSM JSVal

  toJSValListOf :: [a] -> JSM JSVal
  toJSValListOf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: MutabilityType (*)). [JSVal] -> JSM (SomeJSArray m)
AI.fromListIO forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. ToJSVal a => a -> JSM JSVal
toJSVal

  -- default toJSVal :: PToJSVal a => a -> JSM (JSVal a)
  -- toJSVal x = return (pToJSVal x)

  default toJSVal :: (Generic a, GToJSVal (Rep a ())) => a -> JSM JSVal
  toJSVal = forall a.
(Generic a, GToJSVal (Rep a ())) =>
(String -> String) -> a -> JSM JSVal
toJSVal_generic forall a. a -> a
id

fromJustWithStack :: JSadddleHasCallStack => Maybe a -> a
fromJustWithStack :: forall a. JSadddleHasCallStack => Maybe a -> a
fromJustWithStack Maybe a
Nothing = forall a. HasCallStack => String -> a
error String
"fromJSValUnchecked: fromJSVal result was Nothing"
fromJustWithStack (Just a
x) = a
x

class FromJSVal a where
  fromJSVal :: JSVal -> JSM (Maybe a)

#if MIN_VERSION_base(4,9,0) && defined(JSADDLE_HAS_CALL_STACK)
  fromJSValUnchecked :: JSadddleHasCallStack => JSVal -> JSM a
#ifdef CHECK_UNCHECKED
  fromJSValUnchecked v = fromJSVal v >>= \case
                             Nothing -> error "fromJSValUnchecked: fromJSVal result was Nothing"
                             Just x  -> return x
#else
  fromJSValUnchecked = fmap fromJustWithStack . fromJSVal
#endif
#else
  fromJSValUnchecked :: JSVal -> JSM a
  fromJSValUnchecked = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal
#endif
  {-# INLINE fromJSValUnchecked #-}

  fromJSValListOf :: JSVal -> JSM (Maybe [a])
  fromJSValListOf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: MutabilityType (*)). SomeJSArray m -> JSM [JSVal]
AI.toListIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce) -- fixme should check that it's an array

#if MIN_VERSION_base(4,9,0) && defined(JSADDLE_HAS_CALL_STACK)
  fromJSValUncheckedListOf :: JSadddleHasCallStack => JSVal -> JSM [a]
#else
  fromJSValUncheckedListOf :: JSVal -> JSM [a]
#endif
  fromJSValUncheckedListOf = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: MutabilityType (*)). SomeJSArray m -> JSM [JSVal]
AI.toListIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

  -- default fromJSVal :: PFromJSVal a => JSVal a -> JSM (Maybe a)
  -- fromJSVal x = return (Just (pFromJSVal x))

  default fromJSVal :: (Generic a, GFromJSVal (Rep a ())) => JSVal -> JSM (Maybe a)
  fromJSVal = forall a.
(Generic a, GFromJSVal (Rep a ())) =>
(String -> String) -> JSVal -> JSM (Maybe a)
fromJSVal_generic forall a. a -> a
id

  -- default fromJSValUnchecked :: PFromJSVal a => a -> IO a
  -- fromJSValUnchecked x = return (pFromJSVal x)

-- -----------------------------------------------------------------------------

class GToJSVal a where
  gToJSVal :: (String -> String) -> Bool -> a -> JSM JSVal

class GToJSProp a where
  gToJSProp :: (String -> String) -> JSVal -> a -> JSM ()

class GToJSArr a where
  gToJSArr :: (String -> String) -> MutableJSArray -> a -> JSM ()

instance (ToJSVal b) => GToJSVal (K1 a b c) where
  gToJSVal :: (String -> String) -> Bool -> K1 a b c -> JSM JSVal
gToJSVal String -> String
_ Bool
_ (K1 b
x) = forall a. ToJSVal a => a -> JSM JSVal
toJSVal b
x

instance GToJSVal p => GToJSVal (Par1 p) where
  gToJSVal :: (String -> String) -> Bool -> Par1 p -> JSM JSVal
gToJSVal String -> String
f Bool
b (Par1 p
p) = forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f Bool
b p
p

instance GToJSVal (f p) => GToJSVal (Rec1 f p) where
  gToJSVal :: (String -> String) -> Bool -> Rec1 f p -> JSM JSVal
gToJSVal String -> String
f Bool
b (Rec1 f p
x) = forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f Bool
b f p
x

instance (GToJSVal (a p), GToJSVal (b p)) => GToJSVal ((a :+: b) p) where
  gToJSVal :: (String -> String) -> Bool -> (:+:) a b p -> JSM JSVal
gToJSVal String -> String
f Bool
_ (L1 a p
x) = forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f Bool
True a p
x
  gToJSVal String -> String
f Bool
_ (R1 b p
x) = forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f Bool
True b p
x

instance (Datatype c, GToJSVal (a p)) => GToJSVal (M1 D c a p) where
  gToJSVal :: (String -> String) -> Bool -> M1 D c a p -> JSM JSVal
gToJSVal String -> String
f Bool
b m :: M1 D c a p
m@(M1 a p
x) = forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f Bool
b a p
x

instance (Constructor c, GToJSVal (a p)) => GToJSVal (M1 C c a p) where
  gToJSVal :: (String -> String) -> Bool -> M1 C c a p -> JSM JSVal
gToJSVal String -> String
f Bool
True m :: M1 C c a p
m@(M1 a p
x) = do
    obj :: Object
obj@(OI.Object JSVal
obj') <- JSM Object
OI.create
    JSVal
v   <- forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f (forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord M1 C c a p
m) a p
x
    JSString -> JSVal -> Object -> JSM ()
OI.setProp (String -> JSString
packJSS forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 C c a p
m) JSVal
v Object
obj
    forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
obj'
  gToJSVal String -> String
f Bool
_ m :: M1 C c a p
m@(M1 a p
x) = forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f (forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord M1 C c a p
m) a p
x

instance (GToJSArr (a p), GToJSArr (b p), GToJSProp (a p), GToJSProp (b p)) => GToJSVal ((a :*: b) p) where
  gToJSVal :: (String -> String) -> Bool -> (:*:) a b p -> JSM JSVal
gToJSVal String -> String
f Bool
True (:*:) a b p
xy = do
    (OI.Object JSVal
obj') <- JSM Object
OI.create
    forall a. GToJSProp a => (String -> String) -> JSVal -> a -> JSM ()
gToJSProp String -> String
f JSVal
obj' (:*:) a b p
xy
    forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
obj'
  gToJSVal String -> String
f Bool
False (:*:) a b p
xy = do
    arr :: MutableJSArray
arr@(AI.SomeJSArray JSVal
arr') <- JSM MutableJSArray
AI.create
    forall a.
GToJSArr a =>
(String -> String) -> MutableJSArray -> a -> JSM ()
gToJSArr String -> String
f MutableJSArray
arr (:*:) a b p
xy
    forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
arr'

instance GToJSVal (a p) => GToJSVal (M1 S c a p) where
  gToJSVal :: (String -> String) -> Bool -> M1 S c a p -> JSM JSVal
gToJSVal String -> String
f Bool
b (M1 a p
x) = forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f Bool
b a p
x

instance (GToJSProp (a p), GToJSProp (b p)) => GToJSProp ((a :*: b) p) where
  gToJSProp :: (String -> String) -> JSVal -> (:*:) a b p -> JSM ()
gToJSProp String -> String
f JSVal
o (a p
x :*: b p
y) = forall a. GToJSProp a => (String -> String) -> JSVal -> a -> JSM ()
gToJSProp String -> String
f JSVal
o a p
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. GToJSProp a => (String -> String) -> JSVal -> a -> JSM ()
gToJSProp String -> String
f JSVal
o b p
y

instance (Selector c, GToJSVal (a p)) => GToJSProp (M1 S c a p) where
  gToJSProp :: (String -> String) -> JSVal -> M1 S c a p -> JSM ()
gToJSProp String -> String
f JSVal
o m :: M1 S c a p
m@(M1 a p
x) = do
    JSVal
r <- forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f Bool
False a p
x
    JSString -> JSVal -> Object -> JSM ()
OI.setProp (String -> JSString
packJSS forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S c a p
m) JSVal
r (JSVal -> Object
OI.Object JSVal
o)

instance (GToJSArr (a p), GToJSArr (b p)) => GToJSArr ((a :*: b) p) where
  gToJSArr :: (String -> String) -> MutableJSArray -> (:*:) a b p -> JSM ()
gToJSArr String -> String
f MutableJSArray
a (a p
x :*: b p
y) = forall a.
GToJSArr a =>
(String -> String) -> MutableJSArray -> a -> JSM ()
gToJSArr String -> String
f MutableJSArray
a a p
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a.
GToJSArr a =>
(String -> String) -> MutableJSArray -> a -> JSM ()
gToJSArr String -> String
f MutableJSArray
a b p
y

instance GToJSVal (a p) => GToJSArr (M1 S c a p) where
  gToJSArr :: (String -> String) -> MutableJSArray -> M1 S c a p -> JSM ()
gToJSArr String -> String
f MutableJSArray
a (M1 a p
x) = do
    JSVal
r <- forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f Bool
False a p
x
    JSVal -> MutableJSArray -> JSM ()
AI.push JSVal
r MutableJSArray
a

instance GToJSVal (V1 p) where
  gToJSVal :: (String -> String) -> Bool -> V1 p -> JSM JSVal
gToJSVal String -> String
_ Bool
_ V1 p
_ = forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
Prim.jsNull

instance GToJSVal (U1 p) where
  gToJSVal :: (String -> String) -> Bool -> U1 p -> JSM JSVal
gToJSVal String -> String
_ Bool
_ U1 p
_ = forall (m :: * -> *) a. Monad m => a -> m a
return JSVal
F.jsTrue

toJSVal_generic :: forall a . (Generic a, GToJSVal (Rep a ()))
                => (String -> String) -> a -> JSM JSVal
toJSVal_generic :: forall a.
(Generic a, GToJSVal (Rep a ())) =>
(String -> String) -> a -> JSM JSVal
toJSVal_generic String -> String
f a
x = forall a.
GToJSVal a =>
(String -> String) -> Bool -> a -> JSM JSVal
gToJSVal String -> String
f Bool
False (forall a x. Generic a => a -> Rep a x
from a
x :: Rep a ())

-- -----------------------------------------------------------------------------

class GFromJSVal a where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe a)

class GFromJSProp a where
  gFromJSProp :: (String -> String) -> JSVal -> JSM (Maybe a)

class GFromJSArr a where
  gFromJSArr :: (String -> String) -> MutableJSArray -> Int -> JSM (Maybe (a,Int))

instance FromJSVal b => GFromJSVal (K1 a b c) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe (K1 a b c))
gFromJSVal String -> String
_ Bool
_ JSVal
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal JSVal
r

instance GFromJSVal p => GFromJSVal (Par1 p) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe (Par1 p))
gFromJSVal String -> String
f Bool
b JSVal
r = forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f Bool
b JSVal
r

instance GFromJSVal (f p) => GFromJSVal (Rec1 f p) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe (Rec1 f p))
gFromJSVal String -> String
f Bool
b JSVal
r = forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f Bool
b JSVal
r

instance (GFromJSVal (a p), GFromJSVal (b p)) => GFromJSVal ((a :+: b) p) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe ((:+:) a b p))
gFromJSVal String -> String
f Bool
b JSVal
r = do
    Maybe (a p)
l <- forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f Bool
True JSVal
r
    case Maybe (a p)
l of
      Just a p
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just a p
x)
      Maybe (a p)
Nothing -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f Bool
True JSVal
r

instance (Datatype c, GFromJSVal (a p)) => GFromJSVal (M1 D c a p) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe (M1 D c a p))
gFromJSVal String -> String
f Bool
b JSVal
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f Bool
b JSVal
r

instance forall c a p . (Constructor c, GFromJSVal (a p)) => GFromJSVal (M1 C c a p) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe (M1 C c a p))
gFromJSVal String -> String
f Bool
True JSVal
r = do
    JSVal
r' <- JSString -> Object -> JSM JSVal
OI.getProp (String -> JSString
packJSS forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
undefined :: M1 C c a p)) (JSVal -> Object
OI.Object JSVal
r)
    forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isUndefined JSVal
r') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Bool
False -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f (forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord (forall a. HasCallStack => a
undefined :: M1 C c a p)) JSVal
r'
  gFromJSVal String -> String
f Bool
_ JSVal
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f (forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord (forall a. HasCallStack => a
undefined :: M1 C c a p)) JSVal
r

instance (GFromJSArr (a p), GFromJSArr (b p), GFromJSProp (a p), GFromJSProp (b p)) => GFromJSVal ((a :*: b) p) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe ((:*:) a b p))
gFromJSVal String -> String
f Bool
True  JSVal
r = forall a.
GFromJSProp a =>
(String -> String) -> JSVal -> JSM (Maybe a)
gFromJSProp String -> String
f JSVal
r
  gFromJSVal String -> String
f Bool
False JSVal
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
GFromJSArr a =>
(String -> String) -> MutableJSArray -> Int -> JSM (Maybe (a, Int))
gFromJSArr String -> String
f (forall s (m :: MutabilityType s). JSVal -> SomeJSArray m
AI.SomeJSArray JSVal
r) Int
0

instance GFromJSVal (a p) => GFromJSVal (M1 S c a p) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe (M1 S c a p))
gFromJSVal String -> String
f Bool
b JSVal
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f Bool
b JSVal
r

instance (GFromJSProp (a p), GFromJSProp (b p)) => GFromJSProp ((a :*: b) p) where
  gFromJSProp :: (String -> String) -> JSVal -> JSM (Maybe ((:*:) a b p))
gFromJSProp String -> String
f JSVal
r = do
    Maybe (a p)
a <- forall a.
GFromJSProp a =>
(String -> String) -> JSVal -> JSM (Maybe a)
gFromJSProp String -> String
f JSVal
r
    case Maybe (a p)
a of
      Maybe (a p)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just a p
a' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a p
a'forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
GFromJSProp a =>
(String -> String) -> JSVal -> JSM (Maybe a)
gFromJSProp String -> String
f JSVal
r

instance forall c a p . (Selector c, GFromJSVal (a p)) => GFromJSProp (M1 S c a p) where
  gFromJSProp :: (String -> String) -> JSVal -> JSM (Maybe (M1 S c a p))
gFromJSProp String -> String
f JSVal
o = do
    JSVal
p <- JSString -> Object -> JSM JSVal
OI.getProp (String -> JSString
packJSS forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall a. HasCallStack => a
undefined :: M1 S c a p)) (JSVal -> Object
OI.Object JSVal
o)
    forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isUndefined JSVal
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Bool
False -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f Bool
False JSVal
p

instance (GFromJSArr (a p), GFromJSArr (b p)) => GFromJSArr ((a :*: b) p) where
  gFromJSArr :: (String -> String)
-> MutableJSArray -> Int -> JSM (Maybe ((:*:) a b p, Int))
gFromJSArr String -> String
f MutableJSArray
r Int
_n = do
    Maybe (a p, Int)
a <- forall a.
GFromJSArr a =>
(String -> String) -> MutableJSArray -> Int -> JSM (Maybe (a, Int))
gFromJSArr String -> String
f MutableJSArray
r Int
0
    case Maybe (a p, Int)
a of
      Just (a p
a',Int
an) -> do
        Maybe (b p, Int)
b <- forall a.
GFromJSArr a =>
(String -> String) -> MutableJSArray -> Int -> JSM (Maybe (a, Int))
gFromJSArr String -> String
f MutableJSArray
r Int
an
        case Maybe (b p, Int)
b of
          Just (b p
b',Int
bn) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (a p
a' forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b p
b',Int
bn))
          Maybe (b p, Int)
_            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

instance (GFromJSVal (a p)) => GFromJSArr (M1 S c a p) where
  gFromJSArr :: (String -> String)
-> MutableJSArray -> Int -> JSM (Maybe (M1 S c a p, Int))
gFromJSArr String -> String
f MutableJSArray
o Int
n = do
    JSVal
r <- forall (m :: MutabilityType (*)). Int -> SomeJSArray m -> JSM JSVal
AI.read Int
n MutableJSArray
o
    forall a. GHCJSPure a -> JSM a
ghcjsPure (JSVal -> GHCJSPure Bool
isUndefined JSVal
r) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Bool
False -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,Int
nforall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f Bool
False JSVal
r

instance GFromJSVal (V1 p) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe (V1 p))
gFromJSVal String -> String
_ Bool
_ JSVal
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

instance GFromJSVal (U1 p) where
  gFromJSVal :: (String -> String) -> Bool -> JSVal -> JSM (Maybe (U1 p))
gFromJSVal String -> String
_ Bool
_ JSVal
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall k (p :: k). U1 p
U1)

fromJSVal_generic :: forall a . (Generic a, GFromJSVal (Rep a ()))
                => (String -> String) -> JSVal -> JSM (Maybe a)
fromJSVal_generic :: forall a.
(Generic a, GFromJSVal (Rep a ())) =>
(String -> String) -> JSVal -> JSM (Maybe a)
fromJSVal_generic String -> String
f JSVal
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a.
GFromJSVal a =>
(String -> String) -> Bool -> JSVal -> JSM (Maybe a)
gFromJSVal String -> String
f Bool
False JSVal
x :: JSM (Maybe (Rep a ())))

-- -----------------------------------------------------------------------------

fromJSVal_pure :: PFromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal_pure :: forall a. PFromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal_pure = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PFromJSVal a => JSVal -> a
pFromJSVal
{-# INLINE fromJSVal_pure #-}

fromJSValUnchecked_pure :: PFromJSVal a => JSVal -> JSM a
fromJSValUnchecked_pure :: forall a. PFromJSVal a => JSVal -> JSM a
fromJSValUnchecked_pure = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PFromJSVal a => JSVal -> a
pFromJSVal
{-# INLINE fromJSValUnchecked_pure #-}

toJSVal_pure :: PToJSVal a => a -> JSM JSVal
toJSVal_pure :: forall a. PToJSVal a => a -> JSM JSVal
toJSVal_pure = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PToJSVal a => a -> JSVal
pToJSVal
{-# INLINE toJSVal_pure #-}

-- -----------------------------------------------------------------------------

packJSS :: String -> JSString
packJSS :: String -> JSString
packJSS = Text -> JSString
textToStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack