{-# LANGUAGE CPP                        #-}
#ifdef ghcjs_HOST_OS
{-# OPTIONS_GHC -Wno-dodgy-exports      #-}
#else
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE ImplicitParams             #-}
#endif
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE AllowAmbiguousTypes        #-}
-----------------------------------------------------------------------------
--
-- Module      :  Language.Javascript.JSaddle.Types
-- Copyright   :  (c) Hamish Mackenzie
-- License     :  MIT
--
-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
--
-- |
--
-----------------------------------------------------------------------------

module Language.Javascript.JSaddle.Types (
  -- * JavaScript Context
    JSContextRef(..)

  -- * The JSM Monad
  , JSM(..)
  , MonadJSM(..)
  , liftJSM

  -- * Pure GHCJS functions
  , GHCJSPure(..)
  , ghcjsPure
  , ghcjsPureMap
  , ghcjsPureId

  -- * JavaScript Value Types
  , JSVal(..)
  , IsJSVal(..)
  , jsval
  , SomeJSArray(..)
  , JSArray
  , MutableJSArray
  , STJSArray
  , Object(..)
  , JSString(..)
  , Nullable(..)
  , JSCallAsFunction

  -- * Debugging
  , JSadddleHasCallStack

  -- * Sync JSM
  , syncPoint
  , syncAfter

#ifndef ghcjs_HOST_OS
  , sendCommand

  -- * JavaScript Context Commands
  , MutabilityType(..)
  , Mutable
  , Immutable
  , IsItMutable(..)
  , Mutability
  , JSValueReceived(..)
  , JSValueForSend(..)
  , JSStringReceived(..)
  , JSStringForSend(..)
  , JSObjectForSend(..)
  , AsyncCommand(..)
  , Command(..)
  , Batch(..)
  , Result(..)
  , BatchResults(..)
  , Results(..)
#endif
) where

import Control.Monad.IO.Class (MonadIO(..))
#ifdef ghcjs_HOST_OS
import GHCJS.Types
import JavaScript.Object.Internal (Object(..))
import JavaScript.Array.Internal (SomeJSArray(..), JSArray, MutableJSArray, STJSArray)
import GHCJS.Nullable (Nullable(..))
#else
import GHCJS.Prim.Internal (JSVal(..), JSValueRef)
import Data.JSString.Internal.Type (JSString(..))
import Control.DeepSeq (NFData(..))
import Control.Monad.Catch (MonadThrow, MonadCatch(..), MonadMask(..))
import Control.Monad.Trans.Cont (ContT(..))
import Control.Monad.Trans.Error (Error(..), ErrorT(..))
import Control.Monad.Trans.Except (ExceptT(..))
import Control.Monad.Trans.Identity (IdentityT(..))
import Control.Monad.Trans.List (ListT(..))
import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Monad.Trans.Reader (ReaderT(..), ask)
import Control.Monad.Trans.RWS.Lazy as Lazy (RWST(..))
import Control.Monad.Trans.RWS.Strict as Strict (RWST(..))
import Control.Monad.Trans.State.Lazy as Lazy (StateT(..))
import Control.Monad.Trans.State.Strict as Strict (StateT(..))
import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(..))
import Control.Monad.Trans.Writer.Strict as Strict (WriterT(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Fix (MonadFix)
import Control.Monad.Ref (MonadAtomicRef(..), MonadRef(..))
import Control.Concurrent.STM.TVar (TVar)
import Control.Concurrent.MVar (MVar)
import Data.Int (Int64)
import Data.Set (Set)
import Data.Text (Text)
import Data.Time.Clock (UTCTime(..))
import Data.Typeable (Typeable)
import Data.Coerce (coerce, Coercible)
import Data.Aeson
       (defaultOptions, genericToEncoding, ToJSON(..), FromJSON(..), Value)
import GHC.Generics (Generic)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import qualified Control.Monad.Fail as Fail
#endif

#if MIN_VERSION_base(4,9,0) && defined(CHECK_UNCHECKED)
import GHC.Stack (HasCallStack)
#else
import GHC.Exts (Constraint)
#endif

-- | Identifies a JavaScript execution context.
--   When using GHCJS this is just '()' since their is only one context.
--   When using GHC it includes the functions JSaddle needs to communicate
--   with the JavaScript context.
#ifdef ghcjs_HOST_OS
type JSContextRef = ()
#else
data JSContextRef = JSContextRef {
    JSContextRef -> Int64
contextId              :: Int64
  , JSContextRef -> UTCTime
startTime              :: UTCTime
  , JSContextRef -> Command -> IO Result
doSendCommand          :: Command -> IO Result
  , JSContextRef -> AsyncCommand -> IO ()
doSendAsyncCommand     :: AsyncCommand -> IO ()
  , JSContextRef -> Object -> JSCallAsFunction -> IO ()
addCallback            :: Object -> JSCallAsFunction -> IO ()
  , JSContextRef -> TVar Int64
nextRef                :: TVar JSValueRef
  , JSContextRef -> Bool -> IO ()
doEnableLogging        :: Bool -> IO ()
  , JSContextRef -> MVar (Set Text)
finalizerThreads       :: MVar (Set Text)
  , JSContextRef -> MVar [Double -> JSM ()]
animationFrameHandlers :: MVar [Double -> JSM ()]
  , JSContextRef -> MVar (Set Int64)
liveRefs               :: MVar (Set Int64)
}
#endif

-- | The 'JSM' monad keeps track of the JavaScript execution context.
--
--   When using GHCJS it is `IO`.
--
--   Given a 'JSM' function and a 'JSContextRef' you can run the
--   function like this...
--
-- > runJSM jsmFunction javaScriptContext
#ifdef ghcjs_HOST_OS
type JSM = IO
#else
newtype JSM a = JSM { JSM a -> ReaderT JSContextRef IO a
unJSM :: ReaderT JSContextRef IO a }
    deriving (a -> JSM b -> JSM a
(a -> b) -> JSM a -> JSM b
(forall a b. (a -> b) -> JSM a -> JSM b)
-> (forall a b. a -> JSM b -> JSM a) -> Functor JSM
forall a b. a -> JSM b -> JSM a
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> JSM b -> JSM a
$c<$ :: forall a b. a -> JSM b -> JSM a
fmap :: (a -> b) -> JSM a -> JSM b
$cfmap :: forall a b. (a -> b) -> JSM a -> JSM b
Functor, Functor JSM
a -> JSM a
Functor JSM
-> (forall a. a -> JSM a)
-> (forall a b. JSM (a -> b) -> JSM a -> JSM b)
-> (forall a b c. (a -> b -> c) -> JSM a -> JSM b -> JSM c)
-> (forall a b. JSM a -> JSM b -> JSM b)
-> (forall a b. JSM a -> JSM b -> JSM a)
-> Applicative JSM
JSM a -> JSM b -> JSM b
JSM a -> JSM b -> JSM a
JSM (a -> b) -> JSM a -> JSM b
(a -> b -> c) -> JSM a -> JSM b -> JSM c
forall a. a -> JSM a
forall a b. JSM a -> JSM b -> JSM a
forall a b. JSM a -> JSM b -> JSM b
forall a b. JSM (a -> b) -> JSM a -> JSM b
forall a b c. (a -> b -> c) -> JSM a -> JSM b -> JSM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: JSM a -> JSM b -> JSM a
$c<* :: forall a b. JSM a -> JSM b -> JSM a
*> :: JSM a -> JSM b -> JSM b
$c*> :: forall a b. JSM a -> JSM b -> JSM b
liftA2 :: (a -> b -> c) -> JSM a -> JSM b -> JSM c
$cliftA2 :: forall a b c. (a -> b -> c) -> JSM a -> JSM b -> JSM c
<*> :: JSM (a -> b) -> JSM a -> JSM b
$c<*> :: forall a b. JSM (a -> b) -> JSM a -> JSM b
pure :: a -> JSM a
$cpure :: forall a. a -> JSM a
$cp1Applicative :: Functor JSM
Applicative, Applicative JSM
a -> JSM a
Applicative JSM
-> (forall a b. JSM a -> (a -> JSM b) -> JSM b)
-> (forall a b. JSM a -> JSM b -> JSM b)
-> (forall a. a -> JSM a)
-> Monad JSM
JSM a -> (a -> JSM b) -> JSM b
JSM a -> JSM b -> JSM b
forall a. a -> JSM a
forall a b. JSM a -> JSM b -> JSM b
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> JSM a
$creturn :: forall a. a -> JSM a
>> :: JSM a -> JSM b -> JSM b
$c>> :: forall a b. JSM a -> JSM b -> JSM b
>>= :: JSM a -> (a -> JSM b) -> JSM b
$c>>= :: forall a b. JSM a -> (a -> JSM b) -> JSM b
$cp1Monad :: Applicative JSM
Monad, Monad JSM
Monad JSM -> (forall a. IO a -> JSM a) -> MonadIO JSM
IO a -> JSM a
forall a. IO a -> JSM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> JSM a
$cliftIO :: forall a. IO a -> JSM a
$cp1MonadIO :: Monad JSM
MonadIO, Monad JSM
Monad JSM -> (forall a. (a -> JSM a) -> JSM a) -> MonadFix JSM
(a -> JSM a) -> JSM a
forall a. (a -> JSM a) -> JSM a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> JSM a) -> JSM a
$cmfix :: forall a. (a -> JSM a) -> JSM a
$cp1MonadFix :: Monad JSM
MonadFix, Monad JSM
e -> JSM a
Monad JSM
-> (forall e a. Exception e => e -> JSM a) -> MonadThrow JSM
forall e a. Exception e => e -> JSM a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> JSM a
$cthrowM :: forall e a. Exception e => e -> JSM a
$cp1MonadThrow :: Monad JSM
MonadThrow, MonadIO JSM
MonadIO JSM
-> (forall b. ((forall a. JSM a -> IO a) -> IO b) -> JSM b)
-> MonadUnliftIO JSM
((forall a. JSM a -> IO a) -> IO b) -> JSM b
forall b. ((forall a. JSM a -> IO a) -> IO b) -> JSM b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: ((forall a. JSM a -> IO a) -> IO b) -> JSM b
$cwithRunInIO :: forall b. ((forall a. JSM a -> IO a) -> IO b) -> JSM b
$cp1MonadUnliftIO :: MonadIO JSM
MonadUnliftIO, Monad JSM
Monad JSM -> (forall a. String -> JSM a) -> MonadFail JSM
String -> JSM a
forall a. String -> JSM a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> JSM a
$cfail :: forall a. String -> JSM a
$cp1MonadFail :: Monad JSM
Fail.MonadFail)

instance MonadCatch JSM where
    JSM a
t catch :: JSM a -> (e -> JSM a) -> JSM a
`catch` e -> JSM a
c = ReaderT JSContextRef IO a -> JSM a
forall a. ReaderT JSContextRef IO a -> JSM a
JSM (JSM a -> ReaderT JSContextRef IO a
forall a. JSM a -> ReaderT JSContextRef IO a
unJSM (JSM a -> JSM a
forall a. JSM a -> JSM a
syncAfter JSM a
t) ReaderT JSContextRef IO a
-> (e -> ReaderT JSContextRef IO a) -> ReaderT JSContextRef IO a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> JSM a -> ReaderT JSContextRef IO a
forall a. JSM a -> ReaderT JSContextRef IO a
unJSM (e -> JSM a
c e
e))

instance MonadMask JSM where
  mask :: ((forall a. JSM a -> JSM a) -> JSM b) -> JSM b
mask (forall a. JSM a -> JSM a) -> JSM b
a = ReaderT JSContextRef IO b -> JSM b
forall a. ReaderT JSContextRef IO a -> JSM a
JSM (ReaderT JSContextRef IO b -> JSM b)
-> ReaderT JSContextRef IO b -> JSM b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
 -> ReaderT JSContextRef IO b)
-> ReaderT JSContextRef IO b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a.
   ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
  -> ReaderT JSContextRef IO b)
 -> ReaderT JSContextRef IO b)
-> ((forall a.
     ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
    -> ReaderT JSContextRef IO b)
-> ReaderT JSContextRef IO b
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
unmask -> JSM b -> ReaderT JSContextRef IO b
forall a. JSM a -> ReaderT JSContextRef IO a
unJSM ((forall a. JSM a -> JSM a) -> JSM b
a ((forall a. JSM a -> JSM a) -> JSM b)
-> (forall a. JSM a -> JSM a) -> JSM b
forall a b. (a -> b) -> a -> b
$ (ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
-> JSM a -> JSM a
forall a.
(ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
-> JSM a -> JSM a
q ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
forall a. ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
unmask)
    where q :: (ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a) -> JSM a -> JSM a
          q :: (ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
-> JSM a -> JSM a
q ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
unmask (JSM ReaderT JSContextRef IO a
b) = JSM a -> JSM a
forall a. JSM a -> JSM a
syncAfter (JSM a -> JSM a)
-> (ReaderT JSContextRef IO a -> JSM a)
-> ReaderT JSContextRef IO a
-> JSM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT JSContextRef IO a -> JSM a
forall a. ReaderT JSContextRef IO a -> JSM a
JSM (ReaderT JSContextRef IO a -> JSM a)
-> ReaderT JSContextRef IO a -> JSM a
forall a b. (a -> b) -> a -> b
$ ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
unmask ReaderT JSContextRef IO a
b
  uninterruptibleMask :: ((forall a. JSM a -> JSM a) -> JSM b) -> JSM b
uninterruptibleMask (forall a. JSM a -> JSM a) -> JSM b
a =
    ReaderT JSContextRef IO b -> JSM b
forall a. ReaderT JSContextRef IO a -> JSM a
JSM (ReaderT JSContextRef IO b -> JSM b)
-> ReaderT JSContextRef IO b -> JSM b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
 -> ReaderT JSContextRef IO b)
-> ReaderT JSContextRef IO b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a.
   ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
  -> ReaderT JSContextRef IO b)
 -> ReaderT JSContextRef IO b)
-> ((forall a.
     ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
    -> ReaderT JSContextRef IO b)
-> ReaderT JSContextRef IO b
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
unmask -> JSM b -> ReaderT JSContextRef IO b
forall a. JSM a -> ReaderT JSContextRef IO a
unJSM ((forall a. JSM a -> JSM a) -> JSM b
a ((forall a. JSM a -> JSM a) -> JSM b)
-> (forall a. JSM a -> JSM a) -> JSM b
forall a b. (a -> b) -> a -> b
$ (ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
-> JSM a -> JSM a
forall a.
(ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
-> JSM a -> JSM a
q ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
forall a. ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
unmask)
      where q :: (ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a) -> JSM a -> JSM a
            q :: (ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a)
-> JSM a -> JSM a
q ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
unmask (JSM ReaderT JSContextRef IO a
b) = JSM a -> JSM a
forall a. JSM a -> JSM a
syncAfter (JSM a -> JSM a)
-> (ReaderT JSContextRef IO a -> JSM a)
-> ReaderT JSContextRef IO a
-> JSM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT JSContextRef IO a -> JSM a
forall a. ReaderT JSContextRef IO a -> JSM a
JSM (ReaderT JSContextRef IO a -> JSM a)
-> ReaderT JSContextRef IO a -> JSM a
forall a b. (a -> b) -> a -> b
$ ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a
unmask ReaderT JSContextRef IO a
b
#if MIN_VERSION_exceptions(0,9,0)
  generalBracket :: JSM a -> (a -> ExitCase b -> JSM c) -> (a -> JSM b) -> JSM (b, c)
generalBracket JSM a
acquire a -> ExitCase b -> JSM c
release a -> JSM b
use =
    ReaderT JSContextRef IO (b, c) -> JSM (b, c)
forall a. ReaderT JSContextRef IO a -> JSM a
JSM (ReaderT JSContextRef IO (b, c) -> JSM (b, c))
-> ReaderT JSContextRef IO (b, c) -> JSM (b, c)
forall a b. (a -> b) -> a -> b
$ ReaderT JSContextRef IO a
-> (a -> ExitCase b -> ReaderT JSContextRef IO c)
-> (a -> ReaderT JSContextRef IO b)
-> ReaderT JSContextRef IO (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (JSM a -> ReaderT JSContextRef IO a
forall a. JSM a -> ReaderT JSContextRef IO a
unJSM JSM a
acquire)
      (\a
resource ExitCase b
exitCase -> JSM c -> ReaderT JSContextRef IO c
forall a. JSM a -> ReaderT JSContextRef IO a
unJSM (JSM c -> ReaderT JSContextRef IO c)
-> JSM c -> ReaderT JSContextRef IO c
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> JSM c
release a
resource ExitCase b
exitCase)
      (JSM b -> ReaderT JSContextRef IO b
forall a. JSM a -> ReaderT JSContextRef IO a
unJSM (JSM b -> ReaderT JSContextRef IO b)
-> (a -> JSM b) -> a -> ReaderT JSContextRef IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM b -> JSM b
forall a. JSM a -> JSM a
syncAfter (JSM b -> JSM b) -> (a -> JSM b) -> a -> JSM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> JSM b
use)
#endif

#endif

-- | Forces execution of pending asyncronous code
syncPoint :: JSM ()
#ifdef ghcjs_HOST_OS
syncPoint = return ()
#else
syncPoint :: JSM ()
syncPoint = do
    Result
SyncResult <- Command -> JSM Result
sendCommand Command
Sync
    () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif

-- | Forces execution of pending asyncronous code after performing `f`
syncAfter :: JSM a -> JSM a
#ifdef ghcjs_HOST_OS
syncAfter = id
#else
syncAfter :: JSM a -> JSM a
syncAfter JSM a
f = do
    a
result <- JSM a
f
    JSM ()
syncPoint
    a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
#endif

#ifndef ghcjs_HOST_OS
sendCommand :: Command -> JSM Result
sendCommand :: Command -> JSM Result
sendCommand Command
cmd = do
    Command -> IO Result
s <- JSContextRef -> Command -> IO Result
doSendCommand (JSContextRef -> Command -> IO Result)
-> JSM JSContextRef -> JSM (Command -> IO Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT JSContextRef IO JSContextRef -> JSM JSContextRef
forall a. ReaderT JSContextRef IO a -> JSM a
JSM ReaderT JSContextRef IO JSContextRef
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    IO Result -> JSM Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> JSM Result) -> IO Result -> JSM Result
forall a b. (a -> b) -> a -> b
$ Command -> IO Result
s Command
cmd
#endif

-- | Type we can give to functions that are pure when using ghcjs, but
--   live in JSM when using jsaddle.
--
--   Some functions that can be pure in GHCJS cannot be implemented in
--   a pure way in JSaddle (because we need to know the JSContextRef).
--   Instead we implement versions of these functions in that return
--   `GHCJSPure a` instead of `a`.  To call them in a way that will
--   work when compiling with GHCJS use `ghcjsPure`.
#ifdef ghcjs_HOST_OS
type GHCJSPure a = a
#else
newtype GHCJSPure a = GHCJSPure (JSM a)
#endif

-- | Used when you want to call a functions that is pure in GHCJS, but
--   lives in the JSM in jsaddle.
ghcjsPure :: GHCJSPure a -> JSM a
#ifdef ghcjs_HOST_OS
ghcjsPure = pure
#else
ghcjsPure :: GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure JSM a
x) = JSM a
x
#endif
{-# INLINE ghcjsPure #-}

ghcjsPureMap :: (a -> b) -> GHCJSPure a -> GHCJSPure b
#ifdef ghcjs_HOST_OS
ghcjsPureMap = id
#else
ghcjsPureMap :: (a -> b) -> GHCJSPure a -> GHCJSPure b
ghcjsPureMap a -> b
f (GHCJSPure JSM a
x) = JSM b -> GHCJSPure b
forall a. JSM a -> GHCJSPure a
GHCJSPure (a -> b
f (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM a
x)
#endif
{-# INLINE ghcjsPureMap #-}

ghcjsPureId :: a -> GHCJSPure a
#ifdef ghcjs_HOST_OS
ghcjsPureId = id
#else
ghcjsPureId :: a -> GHCJSPure a
ghcjsPureId = JSM a -> GHCJSPure a
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM a -> GHCJSPure a) -> (a -> JSM a) -> a -> GHCJSPure a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return
#endif
{-# INLINE ghcjsPureId #-}

-- | The 'MonadJSM' is to 'JSM' what 'MonadIO' is to 'IO'.
--   When using GHCJS it is 'MonadIO'.
#ifdef ghcjs_HOST_OS
type MonadJSM = MonadIO
#else
class (Applicative m, MonadIO m) => MonadJSM m where
    liftJSM' :: JSM a -> m a

    default liftJSM' :: (MonadJSM m', MonadTrans t, m ~ t m') => JSM a -> m a
    liftJSM' = m' a -> t m' a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m' a -> t m' a) -> (JSM a -> m' a) -> JSM a -> t m' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
forall (m' :: * -> *) a. MonadJSM m' => JSM a -> m' a
liftJSM' :: MonadJSM m' => JSM a -> m' a)
    {-# INLINE liftJSM' #-}

instance MonadJSM JSM where
    liftJSM' :: JSM a -> JSM a
liftJSM' = JSM a -> JSM a
forall a. a -> a
id
    {-# INLINE liftJSM' #-}

instance (MonadJSM m) => MonadJSM (ContT r m) where
    liftJSM' :: JSM a -> ContT r m a
liftJSM' = m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContT r m a) -> (JSM a -> m a) -> JSM a -> ContT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (Error e, MonadJSM m) => MonadJSM (ErrorT e m) where
    liftJSM' :: JSM a -> ErrorT e m a
liftJSM' = m a -> ErrorT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ErrorT e m a) -> (JSM a -> m a) -> JSM a -> ErrorT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (MonadJSM m) => MonadJSM (ExceptT e m) where
    liftJSM' :: JSM a -> ExceptT e m a
liftJSM' = m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT e m a) -> (JSM a -> m a) -> JSM a -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (MonadJSM m) => MonadJSM (IdentityT m) where
    liftJSM' :: JSM a -> IdentityT m a
liftJSM' = m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a) -> (JSM a -> m a) -> JSM a -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (MonadJSM m) => MonadJSM (ListT m) where
    liftJSM' :: JSM a -> ListT m a
liftJSM' = m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ListT m a) -> (JSM a -> m a) -> JSM a -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (MonadJSM m) => MonadJSM (MaybeT m) where
    liftJSM' :: JSM a -> MaybeT m a
liftJSM' = m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MaybeT m a) -> (JSM a -> m a) -> JSM a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (MonadJSM m) => MonadJSM (ReaderT r m) where
    liftJSM' :: JSM a -> ReaderT r m a
liftJSM' = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a) -> (JSM a -> m a) -> JSM a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (Monoid w, MonadJSM m) => MonadJSM (Lazy.RWST r w s m) where
    liftJSM' :: JSM a -> RWST r w s m a
liftJSM' = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (JSM a -> m a) -> JSM a -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (Monoid w, MonadJSM m) => MonadJSM (Strict.RWST r w s m) where
    liftJSM' :: JSM a -> RWST r w s m a
liftJSM' = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (JSM a -> m a) -> JSM a -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (MonadJSM m) => MonadJSM (Lazy.StateT s m) where
    liftJSM' :: JSM a -> StateT s m a
liftJSM' = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (JSM a -> m a) -> JSM a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (MonadJSM m) => MonadJSM (Strict.StateT s m) where
    liftJSM' :: JSM a -> StateT s m a
liftJSM' = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (JSM a -> m a) -> JSM a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (Monoid w, MonadJSM m) => MonadJSM (Lazy.WriterT w m) where
    liftJSM' :: JSM a -> WriterT w m a
liftJSM' = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a) -> (JSM a -> m a) -> JSM a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance (Monoid w, MonadJSM m) => MonadJSM (Strict.WriterT w m) where
    liftJSM' :: JSM a -> WriterT w m a
liftJSM' = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a) -> (JSM a -> m a) -> JSM a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
    {-# INLINE liftJSM' #-}

instance MonadRef JSM where
    type Ref JSM = Ref IO
    newRef :: a -> JSM (Ref JSM a)
newRef = IO (IORef a) -> JSM (IORef a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef a) -> JSM (IORef a))
-> (a -> IO (IORef a)) -> a -> JSM (IORef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (IORef a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
    readRef :: Ref JSM a -> JSM a
readRef = IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> JSM a) -> (IORef a -> IO a) -> IORef a -> JSM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> IO a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
    writeRef :: Ref JSM a -> a -> JSM ()
writeRef Ref JSM a
r = IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (a -> IO ()) -> a -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref IO a -> a -> IO ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref IO a
Ref JSM a
r

instance MonadAtomicRef JSM where
    atomicModifyRef :: Ref JSM a -> (a -> (a, b)) -> JSM b
atomicModifyRef Ref JSM a
r = IO b -> JSM b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> JSM b)
-> ((a -> (a, b)) -> IO b) -> (a -> (a, b)) -> JSM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref IO a -> (a -> (a, b)) -> IO b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref IO a
Ref JSM a
r
#endif

-- | The 'liftJSM' is to 'JSM' what 'liftIO' is to 'IO'.
--   When using GHCJS it is 'liftIO'.
liftJSM :: MonadJSM m => JSM a -> m a
#ifdef ghcjs_HOST_OS
liftJSM = liftIO
#else
liftJSM :: JSM a -> m a
liftJSM = JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
#endif
{-# INLINE liftJSM #-}

-- | Type used for Haskell functions called from JavaScript.
type JSCallAsFunction = JSVal      -- ^ Function object
                     -> JSVal      -- ^ this
                     -> [JSVal]    -- ^ Function arguments
                     -> JSM ()     -- ^ Only () (aka 'JSUndefined') can be returned because
                                   --   the function may need to be executed in a
                                   --   different thread.  If you need to get a
                                   --   value out pass in a continuation function
                                   --   as an argument and invoke it from haskell.

#ifndef ghcjs_HOST_OS

class IsJSVal a where
  jsval_ :: a -> GHCJSPure JSVal

  default jsval_ :: Coercible a JSVal => a -> GHCJSPure JSVal
  jsval_ = JSM JSVal -> GHCJSPure JSVal
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM JSVal -> GHCJSPure JSVal)
-> (a -> JSM JSVal) -> a -> GHCJSPure JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM JSVal
forall (m :: * -> *) a. Monad m => a -> m a
return (JSVal -> JSM JSVal) -> (a -> JSVal) -> a -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> JSVal
coerce
  {-# INLINE jsval_ #-}

jsval :: IsJSVal a => a -> GHCJSPure JSVal
jsval :: a -> GHCJSPure JSVal
jsval = a -> GHCJSPure JSVal
forall a. IsJSVal a => a -> GHCJSPure JSVal
jsval_
{-# INLINE jsval #-}

data MutabilityType s = Mutable_ s
                      | Immutable_ s
                      | STMutable s

type Mutable   = Mutable_ ()
type Immutable = Immutable_ ()

data IsItMutable = IsImmutable
                 | IsMutable

type family Mutability (a :: MutabilityType s) :: IsItMutable where
  Mutability Immutable     = IsImmutable
  Mutability Mutable       = IsMutable
  Mutability (STMutable s) = IsMutable

newtype SomeJSArray (m :: MutabilityType s) = SomeJSArray JSVal
  deriving (Typeable)
instance IsJSVal (SomeJSArray m)

-- | See 'JavaScript.Array.Internal.JSArray'
type JSArray        = SomeJSArray Immutable
-- | See 'JavaScript.Array.Internal.MutableJSArray'
type MutableJSArray = SomeJSArray Mutable

-- | See 'JavaScript.Array.Internal.STJSArray'
type STJSArray s    = SomeJSArray (STMutable s)

-- | See 'JavaScript.Object.Internal.Object'
newtype Object = Object JSVal

-- | See 'GHCJS.Nullable.Nullable'
newtype Nullable a = Nullable a

-- | Wrapper used when receiving a 'JSVal' from the JavaScript context
newtype JSValueReceived = JSValueReceived JSValueRef deriving(Int -> JSValueReceived -> ShowS
[JSValueReceived] -> ShowS
JSValueReceived -> String
(Int -> JSValueReceived -> ShowS)
-> (JSValueReceived -> String)
-> ([JSValueReceived] -> ShowS)
-> Show JSValueReceived
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSValueReceived] -> ShowS
$cshowList :: [JSValueReceived] -> ShowS
show :: JSValueReceived -> String
$cshow :: JSValueReceived -> String
showsPrec :: Int -> JSValueReceived -> ShowS
$cshowsPrec :: Int -> JSValueReceived -> ShowS
Show, [JSValueReceived] -> Encoding
[JSValueReceived] -> Value
JSValueReceived -> Encoding
JSValueReceived -> Value
(JSValueReceived -> Value)
-> (JSValueReceived -> Encoding)
-> ([JSValueReceived] -> Value)
-> ([JSValueReceived] -> Encoding)
-> ToJSON JSValueReceived
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JSValueReceived] -> Encoding
$ctoEncodingList :: [JSValueReceived] -> Encoding
toJSONList :: [JSValueReceived] -> Value
$ctoJSONList :: [JSValueReceived] -> Value
toEncoding :: JSValueReceived -> Encoding
$ctoEncoding :: JSValueReceived -> Encoding
toJSON :: JSValueReceived -> Value
$ctoJSON :: JSValueReceived -> Value
ToJSON, Value -> Parser [JSValueReceived]
Value -> Parser JSValueReceived
(Value -> Parser JSValueReceived)
-> (Value -> Parser [JSValueReceived]) -> FromJSON JSValueReceived
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JSValueReceived]
$cparseJSONList :: Value -> Parser [JSValueReceived]
parseJSON :: Value -> Parser JSValueReceived
$cparseJSON :: Value -> Parser JSValueReceived
FromJSON)

-- | Wrapper used when sending a 'JSVal' to the JavaScript context
newtype JSValueForSend = JSValueForSend JSValueRef deriving(Int -> JSValueForSend -> ShowS
[JSValueForSend] -> ShowS
JSValueForSend -> String
(Int -> JSValueForSend -> ShowS)
-> (JSValueForSend -> String)
-> ([JSValueForSend] -> ShowS)
-> Show JSValueForSend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSValueForSend] -> ShowS
$cshowList :: [JSValueForSend] -> ShowS
show :: JSValueForSend -> String
$cshow :: JSValueForSend -> String
showsPrec :: Int -> JSValueForSend -> ShowS
$cshowsPrec :: Int -> JSValueForSend -> ShowS
Show, [JSValueForSend] -> Encoding
[JSValueForSend] -> Value
JSValueForSend -> Encoding
JSValueForSend -> Value
(JSValueForSend -> Value)
-> (JSValueForSend -> Encoding)
-> ([JSValueForSend] -> Value)
-> ([JSValueForSend] -> Encoding)
-> ToJSON JSValueForSend
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JSValueForSend] -> Encoding
$ctoEncodingList :: [JSValueForSend] -> Encoding
toJSONList :: [JSValueForSend] -> Value
$ctoJSONList :: [JSValueForSend] -> Value
toEncoding :: JSValueForSend -> Encoding
$ctoEncoding :: JSValueForSend -> Encoding
toJSON :: JSValueForSend -> Value
$ctoJSON :: JSValueForSend -> Value
ToJSON, Value -> Parser [JSValueForSend]
Value -> Parser JSValueForSend
(Value -> Parser JSValueForSend)
-> (Value -> Parser [JSValueForSend]) -> FromJSON JSValueForSend
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JSValueForSend]
$cparseJSONList :: Value -> Parser [JSValueForSend]
parseJSON :: Value -> Parser JSValueForSend
$cparseJSON :: Value -> Parser JSValueForSend
FromJSON, (forall x. JSValueForSend -> Rep JSValueForSend x)
-> (forall x. Rep JSValueForSend x -> JSValueForSend)
-> Generic JSValueForSend
forall x. Rep JSValueForSend x -> JSValueForSend
forall x. JSValueForSend -> Rep JSValueForSend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSValueForSend x -> JSValueForSend
$cfrom :: forall x. JSValueForSend -> Rep JSValueForSend x
Generic)
instance NFData JSValueForSend

-- | Wrapper used when sending a 'Object' to the JavaScript context
newtype JSObjectForSend = JSObjectForSend JSValueForSend deriving(Int -> JSObjectForSend -> ShowS
[JSObjectForSend] -> ShowS
JSObjectForSend -> String
(Int -> JSObjectForSend -> ShowS)
-> (JSObjectForSend -> String)
-> ([JSObjectForSend] -> ShowS)
-> Show JSObjectForSend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSObjectForSend] -> ShowS
$cshowList :: [JSObjectForSend] -> ShowS
show :: JSObjectForSend -> String
$cshow :: JSObjectForSend -> String
showsPrec :: Int -> JSObjectForSend -> ShowS
$cshowsPrec :: Int -> JSObjectForSend -> ShowS
Show, [JSObjectForSend] -> Encoding
[JSObjectForSend] -> Value
JSObjectForSend -> Encoding
JSObjectForSend -> Value
(JSObjectForSend -> Value)
-> (JSObjectForSend -> Encoding)
-> ([JSObjectForSend] -> Value)
-> ([JSObjectForSend] -> Encoding)
-> ToJSON JSObjectForSend
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JSObjectForSend] -> Encoding
$ctoEncodingList :: [JSObjectForSend] -> Encoding
toJSONList :: [JSObjectForSend] -> Value
$ctoJSONList :: [JSObjectForSend] -> Value
toEncoding :: JSObjectForSend -> Encoding
$ctoEncoding :: JSObjectForSend -> Encoding
toJSON :: JSObjectForSend -> Value
$ctoJSON :: JSObjectForSend -> Value
ToJSON, Value -> Parser [JSObjectForSend]
Value -> Parser JSObjectForSend
(Value -> Parser JSObjectForSend)
-> (Value -> Parser [JSObjectForSend]) -> FromJSON JSObjectForSend
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JSObjectForSend]
$cparseJSONList :: Value -> Parser [JSObjectForSend]
parseJSON :: Value -> Parser JSObjectForSend
$cparseJSON :: Value -> Parser JSObjectForSend
FromJSON, (forall x. JSObjectForSend -> Rep JSObjectForSend x)
-> (forall x. Rep JSObjectForSend x -> JSObjectForSend)
-> Generic JSObjectForSend
forall x. Rep JSObjectForSend x -> JSObjectForSend
forall x. JSObjectForSend -> Rep JSObjectForSend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSObjectForSend x -> JSObjectForSend
$cfrom :: forall x. JSObjectForSend -> Rep JSObjectForSend x
Generic)
instance NFData JSObjectForSend

-- | Wrapper used when receiving a 'JSString' from the JavaScript context
newtype JSStringReceived = JSStringReceived Text deriving(Int -> JSStringReceived -> ShowS
[JSStringReceived] -> ShowS
JSStringReceived -> String
(Int -> JSStringReceived -> ShowS)
-> (JSStringReceived -> String)
-> ([JSStringReceived] -> ShowS)
-> Show JSStringReceived
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSStringReceived] -> ShowS
$cshowList :: [JSStringReceived] -> ShowS
show :: JSStringReceived -> String
$cshow :: JSStringReceived -> String
showsPrec :: Int -> JSStringReceived -> ShowS
$cshowsPrec :: Int -> JSStringReceived -> ShowS
Show, [JSStringReceived] -> Encoding
[JSStringReceived] -> Value
JSStringReceived -> Encoding
JSStringReceived -> Value
(JSStringReceived -> Value)
-> (JSStringReceived -> Encoding)
-> ([JSStringReceived] -> Value)
-> ([JSStringReceived] -> Encoding)
-> ToJSON JSStringReceived
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JSStringReceived] -> Encoding
$ctoEncodingList :: [JSStringReceived] -> Encoding
toJSONList :: [JSStringReceived] -> Value
$ctoJSONList :: [JSStringReceived] -> Value
toEncoding :: JSStringReceived -> Encoding
$ctoEncoding :: JSStringReceived -> Encoding
toJSON :: JSStringReceived -> Value
$ctoJSON :: JSStringReceived -> Value
ToJSON, Value -> Parser [JSStringReceived]
Value -> Parser JSStringReceived
(Value -> Parser JSStringReceived)
-> (Value -> Parser [JSStringReceived])
-> FromJSON JSStringReceived
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JSStringReceived]
$cparseJSONList :: Value -> Parser [JSStringReceived]
parseJSON :: Value -> Parser JSStringReceived
$cparseJSON :: Value -> Parser JSStringReceived
FromJSON)

-- | Wrapper used when sending a 'JString' to the JavaScript context
newtype JSStringForSend = JSStringForSend Text deriving(Int -> JSStringForSend -> ShowS
[JSStringForSend] -> ShowS
JSStringForSend -> String
(Int -> JSStringForSend -> ShowS)
-> (JSStringForSend -> String)
-> ([JSStringForSend] -> ShowS)
-> Show JSStringForSend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSStringForSend] -> ShowS
$cshowList :: [JSStringForSend] -> ShowS
show :: JSStringForSend -> String
$cshow :: JSStringForSend -> String
showsPrec :: Int -> JSStringForSend -> ShowS
$cshowsPrec :: Int -> JSStringForSend -> ShowS
Show, [JSStringForSend] -> Encoding
[JSStringForSend] -> Value
JSStringForSend -> Encoding
JSStringForSend -> Value
(JSStringForSend -> Value)
-> (JSStringForSend -> Encoding)
-> ([JSStringForSend] -> Value)
-> ([JSStringForSend] -> Encoding)
-> ToJSON JSStringForSend
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JSStringForSend] -> Encoding
$ctoEncodingList :: [JSStringForSend] -> Encoding
toJSONList :: [JSStringForSend] -> Value
$ctoJSONList :: [JSStringForSend] -> Value
toEncoding :: JSStringForSend -> Encoding
$ctoEncoding :: JSStringForSend -> Encoding
toJSON :: JSStringForSend -> Value
$ctoJSON :: JSStringForSend -> Value
ToJSON, Value -> Parser [JSStringForSend]
Value -> Parser JSStringForSend
(Value -> Parser JSStringForSend)
-> (Value -> Parser [JSStringForSend]) -> FromJSON JSStringForSend
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JSStringForSend]
$cparseJSONList :: Value -> Parser [JSStringForSend]
parseJSON :: Value -> Parser JSStringForSend
$cparseJSON :: Value -> Parser JSStringForSend
FromJSON, (forall x. JSStringForSend -> Rep JSStringForSend x)
-> (forall x. Rep JSStringForSend x -> JSStringForSend)
-> Generic JSStringForSend
forall x. Rep JSStringForSend x -> JSStringForSend
forall x. JSStringForSend -> Rep JSStringForSend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSStringForSend x -> JSStringForSend
$cfrom :: forall x. JSStringForSend -> Rep JSStringForSend x
Generic)
instance NFData JSStringForSend

-- | Command sent to a JavaScript context for execution asynchronously
data AsyncCommand = FreeRef Text JSValueForSend
                  | FreeRefs Text
                  | SetPropertyByName JSObjectForSend JSStringForSend JSValueForSend
                  | SetPropertyAtIndex JSObjectForSend Int JSValueForSend
                  | StringToValue JSStringForSend JSValueForSend
                  | NumberToValue Double JSValueForSend
                  | JSONValueToValue Value JSValueForSend
                  | GetPropertyByName JSObjectForSend JSStringForSend JSValueForSend
                  | GetPropertyAtIndex JSObjectForSend Int JSValueForSend
                  | CallAsFunction JSObjectForSend JSObjectForSend [JSValueForSend] JSValueForSend
                  | CallAsConstructor JSObjectForSend [JSValueForSend] JSValueForSend
                  | NewEmptyObject JSValueForSend
                  | NewAsyncCallback JSValueForSend
                  | NewSyncCallback JSValueForSend
                  | FreeCallback JSValueForSend
                  | NewArray [JSValueForSend] JSValueForSend
                  | EvaluateScript JSStringForSend JSValueForSend
                  | SyncWithAnimationFrame JSValueForSend
                  | StartSyncBlock
                  | EndSyncBlock
                   deriving (Int -> AsyncCommand -> ShowS
[AsyncCommand] -> ShowS
AsyncCommand -> String
(Int -> AsyncCommand -> ShowS)
-> (AsyncCommand -> String)
-> ([AsyncCommand] -> ShowS)
-> Show AsyncCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsyncCommand] -> ShowS
$cshowList :: [AsyncCommand] -> ShowS
show :: AsyncCommand -> String
$cshow :: AsyncCommand -> String
showsPrec :: Int -> AsyncCommand -> ShowS
$cshowsPrec :: Int -> AsyncCommand -> ShowS
Show, (forall x. AsyncCommand -> Rep AsyncCommand x)
-> (forall x. Rep AsyncCommand x -> AsyncCommand)
-> Generic AsyncCommand
forall x. Rep AsyncCommand x -> AsyncCommand
forall x. AsyncCommand -> Rep AsyncCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AsyncCommand x -> AsyncCommand
$cfrom :: forall x. AsyncCommand -> Rep AsyncCommand x
Generic)

instance ToJSON AsyncCommand where
    toEncoding :: AsyncCommand -> Encoding
toEncoding = Options -> AsyncCommand -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON AsyncCommand

instance NFData AsyncCommand

-- | Command sent to a JavaScript context for execution synchronously
data Command = DeRefVal JSValueForSend
             | ValueToBool JSValueForSend
             | ValueToNumber JSValueForSend
             | ValueToString JSValueForSend
             | ValueToJSON JSValueForSend
             | ValueToJSONValue JSValueForSend
             | IsNull JSValueForSend
             | IsUndefined JSValueForSend
             | StrictEqual JSValueForSend JSValueForSend
             | InstanceOf JSValueForSend JSObjectForSend
             | PropertyNames JSObjectForSend
             | Sync
             deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show, (forall x. Command -> Rep Command x)
-> (forall x. Rep Command x -> Command) -> Generic Command
forall x. Rep Command x -> Command
forall x. Command -> Rep Command x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Command x -> Command
$cfrom :: forall x. Command -> Rep Command x
Generic)

instance ToJSON Command where
    toEncoding :: Command -> Encoding
toEncoding = Options -> Command -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON Command

instance NFData Command

-- | Batch of commands that can be sent together to the JavaScript context
data Batch = Batch [Either AsyncCommand Command] Bool Int
             deriving (Int -> Batch -> ShowS
[Batch] -> ShowS
Batch -> String
(Int -> Batch -> ShowS)
-> (Batch -> String) -> ([Batch] -> ShowS) -> Show Batch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Batch] -> ShowS
$cshowList :: [Batch] -> ShowS
show :: Batch -> String
$cshow :: Batch -> String
showsPrec :: Int -> Batch -> ShowS
$cshowsPrec :: Int -> Batch -> ShowS
Show, (forall x. Batch -> Rep Batch x)
-> (forall x. Rep Batch x -> Batch) -> Generic Batch
forall x. Rep Batch x -> Batch
forall x. Batch -> Rep Batch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Batch x -> Batch
$cfrom :: forall x. Batch -> Rep Batch x
Generic)

instance ToJSON Batch where
    toEncoding :: Batch -> Encoding
toEncoding = Options -> Batch -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON Batch

instance NFData Batch

-- | Result of a 'Command' returned from the JavaScript context
data Result = DeRefValResult JSValueRef Text
            | ValueToBoolResult Bool
            | ValueToNumberResult Double
            | ValueToStringResult JSStringReceived
            | ValueToJSONResult JSStringReceived
            | ValueToJSONValueResult Value
            | IsNullResult Bool
            | IsUndefinedResult Bool
            | StrictEqualResult Bool
            | InstanceOfResult Bool
            | PropertyNamesResult [JSStringReceived]
            | ThrowJSValue JSValueReceived
            | SyncResult
            deriving (Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show, (forall x. Result -> Rep Result x)
-> (forall x. Rep Result x -> Result) -> Generic Result
forall x. Rep Result x -> Result
forall x. Result -> Rep Result x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Result x -> Result
$cfrom :: forall x. Result -> Rep Result x
Generic)

instance ToJSON Result where
    toEncoding :: Result -> Encoding
toEncoding = Options -> Result -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON Result

data BatchResults = Success [JSValueReceived] [Result]
                  | Failure [JSValueReceived] [Result] JSValueReceived String
             deriving (Int -> BatchResults -> ShowS
[BatchResults] -> ShowS
BatchResults -> String
(Int -> BatchResults -> ShowS)
-> (BatchResults -> String)
-> ([BatchResults] -> ShowS)
-> Show BatchResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchResults] -> ShowS
$cshowList :: [BatchResults] -> ShowS
show :: BatchResults -> String
$cshow :: BatchResults -> String
showsPrec :: Int -> BatchResults -> ShowS
$cshowsPrec :: Int -> BatchResults -> ShowS
Show, (forall x. BatchResults -> Rep BatchResults x)
-> (forall x. Rep BatchResults x -> BatchResults)
-> Generic BatchResults
forall x. Rep BatchResults x -> BatchResults
forall x. BatchResults -> Rep BatchResults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchResults x -> BatchResults
$cfrom :: forall x. BatchResults -> Rep BatchResults x
Generic)

instance ToJSON BatchResults where
    toEncoding :: BatchResults -> Encoding
toEncoding = Options -> BatchResults -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON BatchResults

data Results = BatchResults Int BatchResults
             | Duplicate Int Int
             | Callback Int BatchResults JSValueReceived JSValueReceived JSValueReceived [JSValueReceived]
             | ProtocolError Text
             deriving (Int -> Results -> ShowS
[Results] -> ShowS
Results -> String
(Int -> Results -> ShowS)
-> (Results -> String) -> ([Results] -> ShowS) -> Show Results
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Results] -> ShowS
$cshowList :: [Results] -> ShowS
show :: Results -> String
$cshow :: Results -> String
showsPrec :: Int -> Results -> ShowS
$cshowsPrec :: Int -> Results -> ShowS
Show, (forall x. Results -> Rep Results x)
-> (forall x. Rep Results x -> Results) -> Generic Results
forall x. Rep Results x -> Results
forall x. Results -> Rep Results x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Results x -> Results
$cfrom :: forall x. Results -> Rep Results x
Generic)

instance ToJSON Results where
    toEncoding :: Results -> Encoding
toEncoding = Options -> Results -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON Results
#endif

-- | Like HasCallStack, but only when jsaddle cabal flag check-unchecked is set
#if MIN_VERSION_base(4,9,0) && defined(CHECK_UNCHECKED)
type JSadddleHasCallStack = HasCallStack
#else
type JSadddleHasCallStack = (() :: Constraint)
#endif