{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef USE_TEMPLATE_HASKELL
{-# LANGUAGE TemplateHaskell #-}
#endif
#ifdef ghcjs_HOST_OS
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE JavaScriptFFI #-}
#endif
module Foreign.JavaScript.TH ( module Foreign.JavaScript.TH
#ifdef USE_TEMPLATE_HASKELL
                             , Safety (..)
#endif
                             ) where

import Foreign.JavaScript.Orphans ()
import Prelude hiding ((!!))
import Reflex.Class
import Reflex.Adjustable.Class
import Reflex.DynamicWriter.Base
import Reflex.EventWriter.Base
import Reflex.Host.Class
import Reflex.PerformEvent.Base
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Base
import Reflex.Requester.Base
import Reflex.Query.Base (QueryT (..))

#ifdef USE_TEMPLATE_HASKELL
import Language.Haskell.TH
#endif

import GHCJS.DOM.Types (JSContextRef, Node (..), askJSM)
#ifdef ghcjs_HOST_OS
import qualified GHCJS.Buffer as JS
import GHCJS.DOM.Types (MonadJSM)
import qualified GHCJS.DOM.Types as JS
import qualified GHCJS.Foreign as JS
import qualified GHCJS.Foreign.Callback as JS
import qualified GHCJS.Foreign.Callback.Internal (Callback (..))
import qualified JavaScript.Array as JS
import qualified JavaScript.Array.Internal (SomeJSArray (..))
import qualified JavaScript.Object as JS
import qualified JavaScript.Object.Internal (Object (..))
import qualified JavaScript.TypedArray.ArrayBuffer as JSArrayBuffer

import Data.Hashable
import Data.Word
import Foreign.C.Types
import Foreign.Ptr
import Text.Encoding.Z
#else
import Control.Lens.Operators ((^.))
import Data.Word (Word8)
import GHCJS.DOM.Types (JSVal, MonadJSM (..), liftJSM, runJSM, toJSString, toJSVal)
import Language.Javascript.JSaddle (Function (..), array, eval, freeFunction, function, js, js1, jss, valBool,
                                    valIsNull, valIsUndefined, valMakeNumber, valMakeString, valToBool,
                                    valToNumber, valToText, valUndefined, (!!))
#endif

import Control.Concurrent
import Control.Monad
import Control.Monad.Exception
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.Ref
import Control.Monad.State
import qualified Control.Monad.State.Strict as Strict
import Control.Monad.Trans.Control
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Coerce (coerce)
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T

class Monad m => HasJSContext m where
  type JSContextPhantom m :: *
  askJSContext :: m (JSContextSingleton (JSContextPhantom m))

type HasWebView = HasJSContext
-- Not sure if we should deprecate this {-# DEPRECATED HasWebView "Use HasJSContext" #-}

instance HasJSContext m => HasJSContext (ReaderT r m) where
  type JSContextPhantom (ReaderT r m) = JSContextPhantom m
  askJSContext :: ReaderT r m (JSContextSingleton (JSContextPhantom (ReaderT r m)))
askJSContext = m (JSContextSingleton (JSContextPhantom m))
-> ReaderT r m (JSContextSingleton (JSContextPhantom m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

instance HasJSContext m => HasJSContext (StateT r m) where
  type JSContextPhantom (StateT r m) = JSContextPhantom m
  askJSContext :: StateT r m (JSContextSingleton (JSContextPhantom (StateT r m)))
askJSContext = m (JSContextSingleton (JSContextPhantom m))
-> StateT r m (JSContextSingleton (JSContextPhantom m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

instance HasJSContext m => HasJSContext (Strict.StateT r m) where
  type JSContextPhantom (Strict.StateT r m) = JSContextPhantom m
  askJSContext :: StateT r m (JSContextSingleton (JSContextPhantom (StateT r m)))
askJSContext = m (JSContextSingleton (JSContextPhantom m))
-> StateT r m (JSContextSingleton (JSContextPhantom m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

instance HasJSContext m => HasJSContext (PostBuildT t m) where
  type JSContextPhantom (PostBuildT t m) = JSContextPhantom m
  askJSContext :: PostBuildT
  t m (JSContextSingleton (JSContextPhantom (PostBuildT t m)))
askJSContext = m (JSContextSingleton (JSContextPhantom m))
-> PostBuildT t m (JSContextSingleton (JSContextPhantom m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

instance (ReflexHost t, HasJSContext (HostFrame t)) => HasJSContext (PerformEventT t m) where
  type JSContextPhantom (PerformEventT t m) = JSContextPhantom (HostFrame t)
  askJSContext :: PerformEventT
  t m (JSContextSingleton (JSContextPhantom (PerformEventT t m)))
askJSContext = RequesterT
  t
  (HostFrame t)
  Identity
  (HostFrame t)
  (JSContextSingleton (JSContextPhantom (HostFrame t)))
-> PerformEventT
     t m (JSContextSingleton (JSContextPhantom (HostFrame t)))
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT
   t
   (HostFrame t)
   Identity
   (HostFrame t)
   (JSContextSingleton (JSContextPhantom (HostFrame t)))
 -> PerformEventT
      t m (JSContextSingleton (JSContextPhantom (HostFrame t))))
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (JSContextSingleton (JSContextPhantom (HostFrame t)))
-> PerformEventT
     t m (JSContextSingleton (JSContextPhantom (HostFrame t)))
forall a b. (a -> b) -> a -> b
$ HostFrame t (JSContextSingleton (JSContextPhantom (HostFrame t)))
-> RequesterT
     t
     (HostFrame t)
     Identity
     (HostFrame t)
     (JSContextSingleton (JSContextPhantom (HostFrame t)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift HostFrame t (JSContextSingleton (JSContextPhantom (HostFrame t)))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

instance HasJSContext m => HasJSContext (EventWriterT t w m) where
  type JSContextPhantom (EventWriterT t w m) = JSContextPhantom m
  askJSContext :: EventWriterT
  t w m (JSContextSingleton (JSContextPhantom (EventWriterT t w m)))
askJSContext = m (JSContextSingleton (JSContextPhantom m))
-> EventWriterT t w m (JSContextSingleton (JSContextPhantom m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

instance HasJSContext m => HasJSContext (DynamicWriterT t w m) where
  type JSContextPhantom (DynamicWriterT t w m) = JSContextPhantom m
  askJSContext :: DynamicWriterT
  t
  w
  m
  (JSContextSingleton (JSContextPhantom (DynamicWriterT t w m)))
askJSContext = m (JSContextSingleton (JSContextPhantom m))
-> DynamicWriterT t w m (JSContextSingleton (JSContextPhantom m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

instance HasJSContext m => HasJSContext (RequesterT t request response m) where
  type JSContextPhantom (RequesterT t request response m) = JSContextPhantom m
  askJSContext :: RequesterT
  t
  request
  response
  m
  (JSContextSingleton
     (JSContextPhantom (RequesterT t request response m)))
askJSContext = m (JSContextSingleton (JSContextPhantom m))
-> RequesterT
     t request response m (JSContextSingleton (JSContextPhantom m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

instance HasJSContext m => HasJSContext (QueryT t q m) where
  type JSContextPhantom (QueryT t q m) = JSContextPhantom m
  askJSContext :: QueryT t q m (JSContextSingleton (JSContextPhantom (QueryT t q m)))
askJSContext = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (JSContextSingleton (JSContextPhantom m))
-> QueryT t q m (JSContextSingleton (JSContextPhantom m))
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

newtype WithJSContextSingleton x m a = WithJSContextSingleton { WithJSContextSingleton x m a -> ReaderT (JSContextSingleton x) m a
unWithJSContextSingleton :: ReaderT (JSContextSingleton x) m a } deriving (a -> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
(a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
(forall a b.
 (a -> b)
 -> WithJSContextSingleton x m a -> WithJSContextSingleton x m b)
-> (forall a b.
    a -> WithJSContextSingleton x m b -> WithJSContextSingleton x m a)
-> Functor (WithJSContextSingleton x m)
forall a b.
a -> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
forall a b.
(a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
forall x (m :: * -> *) a b.
Functor m =>
a -> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
forall x (m :: * -> *) a b.
Functor m =>
(a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
$c<$ :: forall x (m :: * -> *) a b.
Functor m =>
a -> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
fmap :: (a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
$cfmap :: forall x (m :: * -> *) a b.
Functor m =>
(a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
Functor, Functor (WithJSContextSingleton x m)
a -> WithJSContextSingleton x m a
Functor (WithJSContextSingleton x m)
-> (forall a. a -> WithJSContextSingleton x m a)
-> (forall a b.
    WithJSContextSingleton x m (a -> b)
    -> WithJSContextSingleton x m a -> WithJSContextSingleton x m b)
-> (forall a b c.
    (a -> b -> c)
    -> WithJSContextSingleton x m a
    -> WithJSContextSingleton x m b
    -> WithJSContextSingleton x m c)
-> (forall a b.
    WithJSContextSingleton x m a
    -> WithJSContextSingleton x m b -> WithJSContextSingleton x m b)
-> (forall a b.
    WithJSContextSingleton x m a
    -> WithJSContextSingleton x m b -> WithJSContextSingleton x m a)
-> Applicative (WithJSContextSingleton x m)
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
WithJSContextSingleton x m (a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
(a -> b -> c)
-> WithJSContextSingleton x m a
-> WithJSContextSingleton x m b
-> WithJSContextSingleton x m c
forall a. a -> WithJSContextSingleton x m a
forall a b.
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
forall a b.
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
forall a b.
WithJSContextSingleton x m (a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
forall a b c.
(a -> b -> c)
-> WithJSContextSingleton x m a
-> WithJSContextSingleton x m b
-> WithJSContextSingleton x m c
forall x (m :: * -> *).
Applicative m =>
Functor (WithJSContextSingleton x m)
forall x (m :: * -> *) a.
Applicative m =>
a -> WithJSContextSingleton x m a
forall x (m :: * -> *) a b.
Applicative m =>
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
forall x (m :: * -> *) a b.
Applicative m =>
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
forall x (m :: * -> *) a b.
Applicative m =>
WithJSContextSingleton x m (a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
forall x (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithJSContextSingleton x m a
-> WithJSContextSingleton x m b
-> WithJSContextSingleton x m 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
<* :: WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
$c<* :: forall x (m :: * -> *) a b.
Applicative m =>
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
*> :: WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
$c*> :: forall x (m :: * -> *) a b.
Applicative m =>
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
liftA2 :: (a -> b -> c)
-> WithJSContextSingleton x m a
-> WithJSContextSingleton x m b
-> WithJSContextSingleton x m c
$cliftA2 :: forall x (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithJSContextSingleton x m a
-> WithJSContextSingleton x m b
-> WithJSContextSingleton x m c
<*> :: WithJSContextSingleton x m (a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
$c<*> :: forall x (m :: * -> *) a b.
Applicative m =>
WithJSContextSingleton x m (a -> b)
-> WithJSContextSingleton x m a -> WithJSContextSingleton x m b
pure :: a -> WithJSContextSingleton x m a
$cpure :: forall x (m :: * -> *) a.
Applicative m =>
a -> WithJSContextSingleton x m a
$cp1Applicative :: forall x (m :: * -> *).
Applicative m =>
Functor (WithJSContextSingleton x m)
Applicative, Applicative (WithJSContextSingleton x m)
a -> WithJSContextSingleton x m a
Applicative (WithJSContextSingleton x m)
-> (forall a b.
    WithJSContextSingleton x m a
    -> (a -> WithJSContextSingleton x m b)
    -> WithJSContextSingleton x m b)
-> (forall a b.
    WithJSContextSingleton x m a
    -> WithJSContextSingleton x m b -> WithJSContextSingleton x m b)
-> (forall a. a -> WithJSContextSingleton x m a)
-> Monad (WithJSContextSingleton x m)
WithJSContextSingleton x m a
-> (a -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m b
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
forall a. a -> WithJSContextSingleton x m a
forall a b.
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
forall a b.
WithJSContextSingleton x m a
-> (a -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m b
forall x (m :: * -> *).
Monad m =>
Applicative (WithJSContextSingleton x m)
forall x (m :: * -> *) a.
Monad m =>
a -> WithJSContextSingleton x m a
forall x (m :: * -> *) a b.
Monad m =>
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
forall x (m :: * -> *) a b.
Monad m =>
WithJSContextSingleton x m a
-> (a -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m 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 -> WithJSContextSingleton x m a
$creturn :: forall x (m :: * -> *) a.
Monad m =>
a -> WithJSContextSingleton x m a
>> :: WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
$c>> :: forall x (m :: * -> *) a b.
Monad m =>
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m b
>>= :: WithJSContextSingleton x m a
-> (a -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m b
$c>>= :: forall x (m :: * -> *) a b.
Monad m =>
WithJSContextSingleton x m a
-> (a -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m b
$cp1Monad :: forall x (m :: * -> *).
Monad m =>
Applicative (WithJSContextSingleton x m)
Monad, Monad (WithJSContextSingleton x m)
Monad (WithJSContextSingleton x m)
-> (forall a. IO a -> WithJSContextSingleton x m a)
-> MonadIO (WithJSContextSingleton x m)
IO a -> WithJSContextSingleton x m a
forall a. IO a -> WithJSContextSingleton x m a
forall x (m :: * -> *).
MonadIO m =>
Monad (WithJSContextSingleton x m)
forall x (m :: * -> *) a.
MonadIO m =>
IO a -> WithJSContextSingleton x m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> WithJSContextSingleton x m a
$cliftIO :: forall x (m :: * -> *) a.
MonadIO m =>
IO a -> WithJSContextSingleton x m a
$cp1MonadIO :: forall x (m :: * -> *).
MonadIO m =>
Monad (WithJSContextSingleton x m)
MonadIO, Monad (WithJSContextSingleton x m)
Monad (WithJSContextSingleton x m)
-> (forall a.
    (a -> WithJSContextSingleton x m a)
    -> WithJSContextSingleton x m a)
-> MonadFix (WithJSContextSingleton x m)
(a -> WithJSContextSingleton x m a) -> WithJSContextSingleton x m a
forall a.
(a -> WithJSContextSingleton x m a) -> WithJSContextSingleton x m a
forall x (m :: * -> *).
MonadFix m =>
Monad (WithJSContextSingleton x m)
forall x (m :: * -> *) a.
MonadFix m =>
(a -> WithJSContextSingleton x m a) -> WithJSContextSingleton x m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> WithJSContextSingleton x m a) -> WithJSContextSingleton x m a
$cmfix :: forall x (m :: * -> *) a.
MonadFix m =>
(a -> WithJSContextSingleton x m a) -> WithJSContextSingleton x m a
$cp1MonadFix :: forall x (m :: * -> *).
MonadFix m =>
Monad (WithJSContextSingleton x m)
MonadFix, m a -> WithJSContextSingleton x m a
(forall (m :: * -> *) a.
 Monad m =>
 m a -> WithJSContextSingleton x m a)
-> MonadTrans (WithJSContextSingleton x)
forall x (m :: * -> *) a.
Monad m =>
m a -> WithJSContextSingleton x m a
forall (m :: * -> *) a.
Monad m =>
m a -> WithJSContextSingleton x m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> WithJSContextSingleton x m a
$clift :: forall x (m :: * -> *) a.
Monad m =>
m a -> WithJSContextSingleton x m a
MonadTrans, Monad (WithJSContextSingleton x m)
e -> WithJSContextSingleton x m a
Monad (WithJSContextSingleton x m)
-> (forall e a. Exception e => e -> WithJSContextSingleton x m a)
-> (forall e a.
    Exception e =>
    WithJSContextSingleton x m a
    -> (e -> WithJSContextSingleton x m a)
    -> WithJSContextSingleton x m a)
-> (forall a b.
    WithJSContextSingleton x m a
    -> WithJSContextSingleton x m b -> WithJSContextSingleton x m a)
-> MonadException (WithJSContextSingleton x m)
WithJSContextSingleton x m a
-> (e -> WithJSContextSingleton x m a)
-> WithJSContextSingleton x m a
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
forall e a. Exception e => e -> WithJSContextSingleton x m a
forall e a.
Exception e =>
WithJSContextSingleton x m a
-> (e -> WithJSContextSingleton x m a)
-> WithJSContextSingleton x m a
forall a b.
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
forall x (m :: * -> *).
MonadException m =>
Monad (WithJSContextSingleton x m)
forall x (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> WithJSContextSingleton x m a
forall x (m :: * -> *) e a.
(MonadException m, Exception e) =>
WithJSContextSingleton x m a
-> (e -> WithJSContextSingleton x m a)
-> WithJSContextSingleton x m a
forall x (m :: * -> *) a b.
MonadException m =>
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
forall (m :: * -> *).
Monad m
-> (forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
$cfinally :: forall x (m :: * -> *) a b.
MonadException m =>
WithJSContextSingleton x m a
-> WithJSContextSingleton x m b -> WithJSContextSingleton x m a
catch :: WithJSContextSingleton x m a
-> (e -> WithJSContextSingleton x m a)
-> WithJSContextSingleton x m a
$ccatch :: forall x (m :: * -> *) e a.
(MonadException m, Exception e) =>
WithJSContextSingleton x m a
-> (e -> WithJSContextSingleton x m a)
-> WithJSContextSingleton x m a
throw :: e -> WithJSContextSingleton x m a
$cthrow :: forall x (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> WithJSContextSingleton x m a
$cp1MonadException :: forall x (m :: * -> *).
MonadException m =>
Monad (WithJSContextSingleton x m)
MonadException, MonadIO (WithJSContextSingleton x m)
MonadException (WithJSContextSingleton x m)
MonadIO (WithJSContextSingleton x m)
-> MonadException (WithJSContextSingleton x m)
-> (forall b.
    ((forall a.
      WithJSContextSingleton x m a -> WithJSContextSingleton x m a)
     -> WithJSContextSingleton x m b)
    -> WithJSContextSingleton x m b)
-> MonadAsyncException (WithJSContextSingleton x m)
((forall a.
  WithJSContextSingleton x m a -> WithJSContextSingleton x m a)
 -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m b
forall b.
((forall a.
  WithJSContextSingleton x m a -> WithJSContextSingleton x m a)
 -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m b
forall x (m :: * -> *).
MonadAsyncException m =>
MonadIO (WithJSContextSingleton x m)
forall x (m :: * -> *).
MonadAsyncException m =>
MonadException (WithJSContextSingleton x m)
forall x (m :: * -> *) b.
MonadAsyncException m =>
((forall a.
  WithJSContextSingleton x m a -> WithJSContextSingleton x m a)
 -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m b
forall (m :: * -> *).
MonadIO m
-> MonadException m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a.
  WithJSContextSingleton x m a -> WithJSContextSingleton x m a)
 -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m b
$cmask :: forall x (m :: * -> *) b.
MonadAsyncException m =>
((forall a.
  WithJSContextSingleton x m a -> WithJSContextSingleton x m a)
 -> WithJSContextSingleton x m b)
-> WithJSContextSingleton x m b
$cp2MonadAsyncException :: forall x (m :: * -> *).
MonadAsyncException m =>
MonadException (WithJSContextSingleton x m)
$cp1MonadAsyncException :: forall x (m :: * -> *).
MonadAsyncException m =>
MonadIO (WithJSContextSingleton x m)
MonadAsyncException)

instance PrimMonad m => PrimMonad (WithJSContextSingleton x m) where
  type PrimState (WithJSContextSingleton x m) = PrimState m
  primitive :: (State# (PrimState (WithJSContextSingleton x m))
 -> (# State# (PrimState (WithJSContextSingleton x m)), a #))
-> WithJSContextSingleton x m a
primitive = m a -> WithJSContextSingleton x m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithJSContextSingleton x m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> WithJSContextSingleton x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

instance Adjustable t m => Adjustable t (WithJSContextSingleton x m) where
  runWithReplace :: WithJSContextSingleton x m a
-> Event t (WithJSContextSingleton x m b)
-> WithJSContextSingleton x m (a, Event t b)
runWithReplace WithJSContextSingleton x m a
a0 Event t (WithJSContextSingleton x m b)
a' = ReaderT (JSContextSingleton x) m (a, Event t b)
-> WithJSContextSingleton x m (a, Event t b)
forall x (m :: * -> *) a.
ReaderT (JSContextSingleton x) m a -> WithJSContextSingleton x m a
WithJSContextSingleton (ReaderT (JSContextSingleton x) m (a, Event t b)
 -> WithJSContextSingleton x m (a, Event t b))
-> ReaderT (JSContextSingleton x) m (a, Event t b)
-> WithJSContextSingleton x m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ ReaderT (JSContextSingleton x) m a
-> Event t (ReaderT (JSContextSingleton x) m b)
-> ReaderT (JSContextSingleton x) m (a, Event t b)
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (WithJSContextSingleton x m a -> ReaderT (JSContextSingleton x) m a
coerce WithJSContextSingleton x m a
a0) (Event t (WithJSContextSingleton x m b)
-> Event t (ReaderT (JSContextSingleton x) m b)
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Event t a -> Event t b
coerceEvent Event t (WithJSContextSingleton x m b)
a')
  traverseIntMapWithKeyWithAdjust :: (Key -> v -> WithJSContextSingleton x m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> WithJSContextSingleton x m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Key -> v -> WithJSContextSingleton x m v'
f IntMap v
dm0 Event t (PatchIntMap v)
dm' = ReaderT
  (JSContextSingleton x) m (IntMap v', Event t (PatchIntMap v'))
-> WithJSContextSingleton x m (IntMap v', Event t (PatchIntMap v'))
forall x (m :: * -> *) a.
ReaderT (JSContextSingleton x) m a -> WithJSContextSingleton x m a
WithJSContextSingleton (ReaderT
   (JSContextSingleton x) m (IntMap v', Event t (PatchIntMap v'))
 -> WithJSContextSingleton
      x m (IntMap v', Event t (PatchIntMap v')))
-> ReaderT
     (JSContextSingleton x) m (IntMap v', Event t (PatchIntMap v'))
-> WithJSContextSingleton x m (IntMap v', Event t (PatchIntMap v'))
forall a b. (a -> b) -> a -> b
$ (Key -> v -> ReaderT (JSContextSingleton x) m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> ReaderT
     (JSContextSingleton x) m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Key -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\Key
k v
v -> WithJSContextSingleton x m v'
-> ReaderT (JSContextSingleton x) m v'
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> ReaderT (JSContextSingleton x) m a
unWithJSContextSingleton (WithJSContextSingleton x m v'
 -> ReaderT (JSContextSingleton x) m v')
-> WithJSContextSingleton x m v'
-> ReaderT (JSContextSingleton x) m v'
forall a b. (a -> b) -> a -> b
$ Key -> v -> WithJSContextSingleton x m v'
f Key
k v
v) (IntMap v -> IntMap v
coerce IntMap v
dm0) (Event t (PatchIntMap v) -> Event t (PatchIntMap v)
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Event t a -> Event t b
coerceEvent Event t (PatchIntMap v)
dm')
  traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> WithJSContextSingleton x m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> WithJSContextSingleton x m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> WithJSContextSingleton x m (v' a)
f DMap k v
dm0 Event t (PatchDMap k v)
dm' = ReaderT
  (JSContextSingleton x) m (DMap k v', Event t (PatchDMap k v'))
-> WithJSContextSingleton x m (DMap k v', Event t (PatchDMap k v'))
forall x (m :: * -> *) a.
ReaderT (JSContextSingleton x) m a -> WithJSContextSingleton x m a
WithJSContextSingleton (ReaderT
   (JSContextSingleton x) m (DMap k v', Event t (PatchDMap k v'))
 -> WithJSContextSingleton
      x m (DMap k v', Event t (PatchDMap k v')))
-> ReaderT
     (JSContextSingleton x) m (DMap k v', Event t (PatchDMap k v'))
-> WithJSContextSingleton x m (DMap k v', Event t (PatchDMap k v'))
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> v a -> ReaderT (JSContextSingleton x) m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> ReaderT
     (JSContextSingleton x) m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k a
k v a
v -> WithJSContextSingleton x m (v' a)
-> ReaderT (JSContextSingleton x) m (v' a)
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> ReaderT (JSContextSingleton x) m a
unWithJSContextSingleton (WithJSContextSingleton x m (v' a)
 -> ReaderT (JSContextSingleton x) m (v' a))
-> WithJSContextSingleton x m (v' a)
-> ReaderT (JSContextSingleton x) m (v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> WithJSContextSingleton x m (v' a)
forall a. k a -> v a -> WithJSContextSingleton x m (v' a)
f k a
k v a
v) (DMap k v -> DMap k v
coerce DMap k v
dm0) (Event t (PatchDMap k v) -> Event t (PatchDMap k v)
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Event t a -> Event t b
coerceEvent Event t (PatchDMap k v)
dm')
  traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> WithJSContextSingleton x m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> WithJSContextSingleton
     x m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> WithJSContextSingleton x m (v' a)
f DMap k v
dm0 Event t (PatchDMapWithMove k v)
dm' = ReaderT
  (JSContextSingleton x)
  m
  (DMap k v', Event t (PatchDMapWithMove k v'))
-> WithJSContextSingleton
     x m (DMap k v', Event t (PatchDMapWithMove k v'))
forall x (m :: * -> *) a.
ReaderT (JSContextSingleton x) m a -> WithJSContextSingleton x m a
WithJSContextSingleton (ReaderT
   (JSContextSingleton x)
   m
   (DMap k v', Event t (PatchDMapWithMove k v'))
 -> WithJSContextSingleton
      x m (DMap k v', Event t (PatchDMapWithMove k v')))
-> ReaderT
     (JSContextSingleton x)
     m
     (DMap k v', Event t (PatchDMapWithMove k v'))
-> WithJSContextSingleton
     x m (DMap k v', Event t (PatchDMapWithMove k v'))
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> v a -> ReaderT (JSContextSingleton x) m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> ReaderT
     (JSContextSingleton x)
     m
     (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k a
k v a
v -> WithJSContextSingleton x m (v' a)
-> ReaderT (JSContextSingleton x) m (v' a)
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> ReaderT (JSContextSingleton x) m a
unWithJSContextSingleton (WithJSContextSingleton x m (v' a)
 -> ReaderT (JSContextSingleton x) m (v' a))
-> WithJSContextSingleton x m (v' a)
-> ReaderT (JSContextSingleton x) m (v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> WithJSContextSingleton x m (v' a)
forall a. k a -> v a -> WithJSContextSingleton x m (v' a)
f k a
k v a
v) (DMap k v -> DMap k v
coerce DMap k v
dm0) (Event t (PatchDMapWithMove k v) -> Event t (PatchDMapWithMove k v)
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Event t a -> Event t b
coerceEvent Event t (PatchDMapWithMove k v)
dm')

instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (WithJSContextSingleton x m) where
  {-# INLINABLE newEventWithTrigger #-}
  newEventWithTrigger :: (EventTrigger t a -> IO (IO ()))
-> WithJSContextSingleton x m (Event t a)
newEventWithTrigger = m (Event t a) -> WithJSContextSingleton x m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> WithJSContextSingleton x m (Event t a))
-> ((EventTrigger t a -> IO (IO ())) -> m (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> WithJSContextSingleton x m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
  {-# INLINABLE newFanEventWithTrigger #-}
  newFanEventWithTrigger :: (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> WithJSContextSingleton x m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f = m (EventSelector t k)
-> WithJSContextSingleton x m (EventSelector t k)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t k)
 -> WithJSContextSingleton x m (EventSelector t k))
-> m (EventSelector t k)
-> WithJSContextSingleton x m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f

instance MonadSubscribeEvent t m => MonadSubscribeEvent t (WithJSContextSingleton x m) where
  {-# INLINABLE subscribeEvent #-}
  subscribeEvent :: Event t a -> WithJSContextSingleton x m (EventHandle t a)
subscribeEvent = m (EventHandle t a) -> WithJSContextSingleton x m (EventHandle t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventHandle t a)
 -> WithJSContextSingleton x m (EventHandle t a))
-> (Event t a -> m (EventHandle t a))
-> Event t a
-> WithJSContextSingleton x m (EventHandle t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t a -> m (EventHandle t a)
forall t (m :: * -> *) a.
MonadSubscribeEvent t m =>
Event t a -> m (EventHandle t a)
subscribeEvent

instance MonadReflexHost t m => MonadReflexHost t (WithJSContextSingleton x m) where
  type ReadPhase (WithJSContextSingleton x m) = ReadPhase m
  {-# INLINABLE fireEventsAndRead #-}
  fireEventsAndRead :: [DSum (EventTrigger t) Identity]
-> ReadPhase (WithJSContextSingleton x m) a
-> WithJSContextSingleton x m a
fireEventsAndRead [DSum (EventTrigger t) Identity]
dm ReadPhase (WithJSContextSingleton x m) a
a = m a -> WithJSContextSingleton x m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithJSContextSingleton x m a)
-> m a -> WithJSContextSingleton x m a
forall a b. (a -> b) -> a -> b
$ [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m a
forall t (m :: * -> *) a.
MonadReflexHost t m =>
[DSum (EventTrigger t) Identity] -> ReadPhase m a -> m a
fireEventsAndRead [DSum (EventTrigger t) Identity]
dm ReadPhase m a
ReadPhase (WithJSContextSingleton x m) a
a
  {-# INLINABLE runHostFrame #-}
  runHostFrame :: HostFrame t a -> WithJSContextSingleton x m a
runHostFrame = m a -> WithJSContextSingleton x m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithJSContextSingleton x m a)
-> (HostFrame t a -> m a)
-> HostFrame t a
-> WithJSContextSingleton x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t a -> m a
forall t (m :: * -> *) a.
MonadReflexHost t m =>
HostFrame t a -> m a
runHostFrame

instance MonadSample t m => MonadSample t (WithJSContextSingleton x m) where
  {-# INLINABLE sample #-}
  sample :: Behavior t a -> WithJSContextSingleton x m a
sample = m a -> WithJSContextSingleton x m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithJSContextSingleton x m a)
-> (Behavior t a -> m a)
-> Behavior t a
-> WithJSContextSingleton x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> m a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample

instance MonadHold t m => MonadHold t (WithJSContextSingleton x m) where
  {-# INLINABLE hold #-}
  hold :: a -> Event t a -> WithJSContextSingleton x m (Behavior t a)
hold a
v0 = m (Behavior t a) -> WithJSContextSingleton x m (Behavior t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Behavior t a) -> WithJSContextSingleton x m (Behavior t a))
-> (Event t a -> m (Behavior t a))
-> Event t a
-> WithJSContextSingleton x m (Behavior t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Event t a -> m (Behavior t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold a
v0
  {-# INLINABLE holdDyn #-}
  holdDyn :: a -> Event t a -> WithJSContextSingleton x m (Dynamic t a)
holdDyn a
v0 = m (Dynamic t a) -> WithJSContextSingleton x m (Dynamic t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> WithJSContextSingleton x m (Dynamic t a))
-> (Event t a -> m (Dynamic t a))
-> Event t a
-> WithJSContextSingleton x m (Dynamic t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Event t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn a
v0
  {-# INLINABLE holdIncremental #-}
  holdIncremental :: PatchTarget p
-> Event t p -> WithJSContextSingleton x m (Incremental t p)
holdIncremental PatchTarget p
v0 = m (Incremental t p) -> WithJSContextSingleton x m (Incremental t p)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Incremental t p)
 -> WithJSContextSingleton x m (Incremental t p))
-> (Event t p -> m (Incremental t p))
-> Event t p
-> WithJSContextSingleton x m (Incremental t p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchTarget p -> Event t p -> m (Incremental t p)
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental PatchTarget p
v0
  {-# INLINABLE buildDynamic #-}
  buildDynamic :: PushM t a -> Event t a -> WithJSContextSingleton x m (Dynamic t a)
buildDynamic PushM t a
a0 = m (Dynamic t a) -> WithJSContextSingleton x m (Dynamic t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> WithJSContextSingleton x m (Dynamic t a))
-> (Event t a -> m (Dynamic t a))
-> Event t a
-> WithJSContextSingleton x m (Dynamic t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PushM t a -> Event t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic PushM t a
a0
  {-# INLINABLE headE #-}
  headE :: Event t a -> WithJSContextSingleton x m (Event t a)
headE = m (Event t a) -> WithJSContextSingleton x m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> WithJSContextSingleton x m (Event t a))
-> (Event t a -> m (Event t a))
-> Event t a
-> WithJSContextSingleton x m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t a -> m (Event t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE

instance MonadTransControl (WithJSContextSingleton x) where
  type StT (WithJSContextSingleton x) a = StT (ReaderT (JSContextSingleton x)) a
  {-# INLINABLE liftWith #-}
  liftWith :: (Run (WithJSContextSingleton x) -> m a)
-> WithJSContextSingleton x m a
liftWith = (forall b.
 ReaderT (JSContextSingleton x) m b -> WithJSContextSingleton x m b)
-> (forall (o :: * -> *) b.
    WithJSContextSingleton x o b -> ReaderT (JSContextSingleton x) o b)
-> (RunDefault
      (WithJSContextSingleton x) (ReaderT (JSContextSingleton x))
    -> m a)
-> WithJSContextSingleton x m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *)
       (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTransControl n) =>
(forall b. n m b -> t m b)
-> (forall (o :: * -> *) b. t o b -> n o b)
-> (RunDefault t n -> m a)
-> t m a
defaultLiftWith forall b.
ReaderT (JSContextSingleton x) m b -> WithJSContextSingleton x m b
forall x (m :: * -> *) a.
ReaderT (JSContextSingleton x) m a -> WithJSContextSingleton x m a
WithJSContextSingleton forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> ReaderT (JSContextSingleton x) m a
forall (o :: * -> *) b.
WithJSContextSingleton x o b -> ReaderT (JSContextSingleton x) o b
unWithJSContextSingleton
  {-# INLINABLE restoreT #-}
  restoreT :: m (StT (WithJSContextSingleton x) a)
-> WithJSContextSingleton x m a
restoreT = (ReaderT (JSContextSingleton x) m a
 -> WithJSContextSingleton x m a)
-> m (StT (ReaderT (JSContextSingleton x)) a)
-> WithJSContextSingleton x m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
       (t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT ReaderT (JSContextSingleton x) m a -> WithJSContextSingleton x m a
forall x (m :: * -> *) a.
ReaderT (JSContextSingleton x) m a -> WithJSContextSingleton x m a
WithJSContextSingleton

instance PerformEvent t m => PerformEvent t (WithJSContextSingleton x m) where
  type Performable (WithJSContextSingleton x m) = WithJSContextSingleton x (Performable m) --TODO: Can we eliminate this wrapper?
  {-# INLINABLE performEvent_ #-}
  performEvent_ :: Event t (Performable (WithJSContextSingleton x m) ())
-> WithJSContextSingleton x m ()
performEvent_ Event t (Performable (WithJSContextSingleton x m) ())
e = (Run (WithJSContextSingleton x) -> m ())
-> WithJSContextSingleton x m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (WithJSContextSingleton x) -> m ())
 -> WithJSContextSingleton x m ())
-> (Run (WithJSContextSingleton x) -> m ())
-> WithJSContextSingleton x m ()
forall a b. (a -> b) -> a -> b
$ \Run (WithJSContextSingleton x)
run -> Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ (Event t (Performable m ()) -> m ())
-> Event t (Performable m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (WithJSContextSingleton x (Performable m) () -> Performable m ())
-> Event t (WithJSContextSingleton x (Performable m) ())
-> Event t (Performable m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithJSContextSingleton x (Performable m) () -> Performable m ()
Run (WithJSContextSingleton x)
run Event t (Performable (WithJSContextSingleton x m) ())
Event t (WithJSContextSingleton x (Performable m) ())
e
  {-# INLINABLE performEvent #-}
  performEvent :: Event t (Performable (WithJSContextSingleton x m) a)
-> WithJSContextSingleton x m (Event t a)
performEvent Event t (Performable (WithJSContextSingleton x m) a)
e = (Run (WithJSContextSingleton x) -> m (Event t a))
-> WithJSContextSingleton x m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (WithJSContextSingleton x) -> m (Event t a))
 -> WithJSContextSingleton x m (Event t a))
-> (Run (WithJSContextSingleton x) -> m (Event t a))
-> WithJSContextSingleton x m (Event t a)
forall a b. (a -> b) -> a -> b
$ \Run (WithJSContextSingleton x)
run -> Event t (Performable m a) -> m (Event t a)
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent (Event t (Performable m a) -> m (Event t a))
-> Event t (Performable m a) -> m (Event t a)
forall a b. (a -> b) -> a -> b
$ (WithJSContextSingleton x (Performable m) a -> Performable m a)
-> Event t (WithJSContextSingleton x (Performable m) a)
-> Event t (Performable m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithJSContextSingleton x (Performable m) a -> Performable m a
Run (WithJSContextSingleton x)
run Event t (Performable (WithJSContextSingleton x m) a)
Event t (WithJSContextSingleton x (Performable m) a)
e

runWithJSContextSingleton :: WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton :: WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton = ReaderT (JSContextSingleton x) m a -> JSContextSingleton x -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT (JSContextSingleton x) m a -> JSContextSingleton x -> m a)
-> (WithJSContextSingleton x m a
    -> ReaderT (JSContextSingleton x) m a)
-> WithJSContextSingleton x m a
-> JSContextSingleton x
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithJSContextSingleton x m a -> ReaderT (JSContextSingleton x) m a
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> ReaderT (JSContextSingleton x) m a
unWithJSContextSingleton

instance (Monad m) => HasJSContext (WithJSContextSingleton x m) where
  type JSContextPhantom (WithJSContextSingleton x m) = x
  askJSContext :: WithJSContextSingleton
  x
  m
  (JSContextSingleton
     (JSContextPhantom (WithJSContextSingleton x m)))
askJSContext = ReaderT (JSContextSingleton x) m (JSContextSingleton x)
-> WithJSContextSingleton x m (JSContextSingleton x)
forall x (m :: * -> *) a.
ReaderT (JSContextSingleton x) m a -> WithJSContextSingleton x m a
WithJSContextSingleton ReaderT (JSContextSingleton x) m (JSContextSingleton x)
forall r (m :: * -> *). MonadReader r m => m r
ask

instance MonadRef m => MonadRef (WithJSContextSingleton x m) where
  type Ref (WithJSContextSingleton x m) = Ref m
  newRef :: a
-> WithJSContextSingleton x m (Ref (WithJSContextSingleton x m) a)
newRef = m (Ref m a) -> WithJSContextSingleton x m (Ref m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Ref m a) -> WithJSContextSingleton x m (Ref m a))
-> (a -> m (Ref m a)) -> a -> WithJSContextSingleton x m (Ref m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  readRef :: Ref (WithJSContextSingleton x m) a -> WithJSContextSingleton x m a
readRef = m a -> WithJSContextSingleton x m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithJSContextSingleton x m a)
-> (Ref m a -> m a) -> Ref m a -> WithJSContextSingleton x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  writeRef :: Ref (WithJSContextSingleton x m) a
-> a -> WithJSContextSingleton x m ()
writeRef Ref (WithJSContextSingleton x m) a
r = m () -> WithJSContextSingleton x m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithJSContextSingleton x m ())
-> (a -> m ()) -> a -> WithJSContextSingleton x m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> a -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref m a
Ref (WithJSContextSingleton x m) a
r

instance MonadAtomicRef m => MonadAtomicRef (WithJSContextSingleton x m) where
  atomicModifyRef :: Ref (WithJSContextSingleton x m) a
-> (a -> (a, b)) -> WithJSContextSingleton x m b
atomicModifyRef Ref (WithJSContextSingleton x m) a
r = m b -> WithJSContextSingleton x m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> WithJSContextSingleton x m b)
-> ((a -> (a, b)) -> m b)
-> (a -> (a, b))
-> WithJSContextSingleton x m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref m a
Ref (WithJSContextSingleton x m) a
r

withJSContextSingleton :: MonadJSM m => (forall x. JSContextSingleton x -> m r) -> m r
withJSContextSingleton :: (forall x. JSContextSingleton x -> m r) -> m r
withJSContextSingleton forall x. JSContextSingleton x -> m r
f = m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM m JSContextRef -> (JSContextRef -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSContextSingleton Any -> m r
forall x. JSContextSingleton x -> m r
f (JSContextSingleton Any -> m r)
-> (JSContextRef -> JSContextSingleton Any) -> JSContextRef -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSContextRef -> JSContextSingleton Any
forall x. JSContextRef -> JSContextSingleton x
JSContextSingleton

-- | Warning: `withJSContextSingletonMono` does not provide the same guarantees that `withJSContextSingleton` does.
withJSContextSingletonMono :: MonadJSM m => (JSContextSingleton () -> m r) -> m r
withJSContextSingletonMono :: (JSContextSingleton () -> m r) -> m r
withJSContextSingletonMono JSContextSingleton () -> m r
f = m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM m JSContextRef -> (JSContextRef -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSContextSingleton () -> m r
f (JSContextSingleton () -> m r)
-> (JSContextRef -> JSContextSingleton ()) -> JSContextRef -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSContextRef -> JSContextSingleton ()
forall x. JSContextRef -> JSContextSingleton x
JSContextSingleton

-- | A singleton type for a given JSContext; we use this to statically guarantee that different JSContexts don't get mixed up
newtype JSContextSingleton x = JSContextSingleton { JSContextSingleton x -> JSContextRef
unJSContextSingleton :: JSContextRef }

#ifdef ghcjs_HOST_OS
type JSFFI_Internal = JS.MutableJSArray -> IO JS.JSVal
newtype JSFFI = JSFFI JSFFI_Internal
#else
newtype JSFFI = JSFFI String
#endif

data JSFun x = JSFun { JSFun x -> JSRef x
unJSFun :: JSRef x
#ifndef ghcjs_HOST_OS
    , JSFun x -> Function
unJSFunction :: Function
#endif
    }

instance ToJS x (JSFun x) where
  withJS :: JSFun x -> (JSRef x -> m r) -> m r
withJS JSFun x
r JSRef x -> m r
f = JSRef x -> m r
f (JSFun x -> JSRef x
forall x. JSFun x -> JSRef x
unJSFun JSFun x
r)

class IsJSContext x where
  data JSRef x

class (Monad m, MonadJSM (JSX m), MonadFix (JSX m), MonadJS x (JSX m)) => HasJS x m | m -> x where
  type JSX m :: * -> *
  liftJS :: JSX m a -> m a

instance HasJS x m => HasJS x (ReaderT r m) where
  type JSX (ReaderT r m) = JSX m
  liftJS :: JSX (ReaderT r m) a -> ReaderT r m a
liftJS = 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)
-> (JSX m a -> m a) -> JSX m a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSX m a -> m a
forall x (m :: * -> *) a. HasJS x m => JSX m a -> m a
liftJS

instance HasJS x m => HasJS x (PostBuildT t m) where
  type JSX (PostBuildT t m) = JSX m
  liftJS :: JSX (PostBuildT t m) a -> PostBuildT t m a
liftJS = m a -> PostBuildT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> PostBuildT t m a)
-> (JSX m a -> m a) -> JSX m a -> PostBuildT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSX m a -> m a
forall x (m :: * -> *) a. HasJS x m => JSX m a -> m a
liftJS

instance (HasJS x (HostFrame t), ReflexHost t) => HasJS x (PerformEventT t m) where
  type JSX (PerformEventT t m) = JSX (HostFrame t)
  liftJS :: JSX (PerformEventT t m) a -> PerformEventT t m a
liftJS = RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
forall k t (m :: k) a.
RequesterT t (HostFrame t) Identity (HostFrame t) a
-> PerformEventT t m a
PerformEventT (RequesterT t (HostFrame t) Identity (HostFrame t) a
 -> PerformEventT t m a)
-> (JSX (HostFrame t) a
    -> RequesterT t (HostFrame t) Identity (HostFrame t) a)
-> JSX (HostFrame t) a
-> PerformEventT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostFrame t a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostFrame t a
 -> RequesterT t (HostFrame t) Identity (HostFrame t) a)
-> (JSX (HostFrame t) a -> HostFrame t a)
-> JSX (HostFrame t) a
-> RequesterT t (HostFrame t) Identity (HostFrame t) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSX (HostFrame t) a -> HostFrame t a
forall x (m :: * -> *) a. HasJS x m => JSX m a -> m a
liftJS

instance HasJS x m => HasJS x (DynamicWriterT t w m) where
  type JSX (DynamicWriterT t w m) = JSX m
  liftJS :: JSX (DynamicWriterT t w m) a -> DynamicWriterT t w m a
liftJS = m a -> DynamicWriterT t w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> DynamicWriterT t w m a)
-> (JSX m a -> m a) -> JSX m a -> DynamicWriterT t w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSX m a -> m a
forall x (m :: * -> *) a. HasJS x m => JSX m a -> m a
liftJS

instance HasJS x m => HasJS x (EventWriterT t w m) where
  type JSX (EventWriterT t w m) = JSX m
  liftJS :: JSX (EventWriterT t w m) a -> EventWriterT t w m a
liftJS = m a -> EventWriterT t w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> EventWriterT t w m a)
-> (JSX m a -> m a) -> JSX m a -> EventWriterT t w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSX m a -> m a
forall x (m :: * -> *) a. HasJS x m => JSX m a -> m a
liftJS

instance HasJS x m => HasJS x (RequesterT t request response m) where
  type JSX (RequesterT t request response m) = JSX m
  liftJS :: JSX (RequesterT t request response m) a
-> RequesterT t request response m a
liftJS = m a -> RequesterT t request response m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RequesterT t request response m a)
-> (JSX m a -> m a) -> JSX m a -> RequesterT t request response m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSX m a -> m a
forall x (m :: * -> *) a. HasJS x m => JSX m a -> m a
liftJS

instance HasJS x m => HasJS x (QueryT t q m) where
  type JSX (QueryT t q m) = JSX m
  liftJS :: JSX (QueryT t q m) a -> QueryT t q m a
liftJS = m a -> QueryT t q m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> QueryT t q m a)
-> (JSX m a -> m a) -> JSX m a -> QueryT t q m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSX m a -> m a
forall x (m :: * -> *) a. HasJS x m => JSX m a -> m a
liftJS

-- | A Monad that is capable of executing JavaScript
class Monad m => MonadJS x m | m -> x where
  runJS :: JSFFI -> [JSRef x] -> m (JSRef x)
  forkJS :: m () -> m ThreadId
  mkJSUndefined :: m (JSRef x)
  isJSNull :: JSRef x -> m Bool
  isJSUndefined :: JSRef x -> m Bool
  fromJSBool :: JSRef x -> m Bool
  fromJSString :: JSRef x -> m String
  fromJSArray :: JSRef x -> m [JSRef x]
  fromJSUint8Array :: JSRef x -> m ByteString
  fromJSNumber :: JSRef x -> m Double
  withJSBool :: Bool -> (JSRef x -> m r) -> m r
  withJSString :: String -> (JSRef x -> m r) -> m r
  withJSNumber :: Double -> (JSRef x -> m r) -> m r
  withJSArray :: [JSRef x] -> (JSRef x -> m r) -> m r
  withJSUint8Array :: ByteString -> (JSUint8Array x -> m r) -> m r
  -- | Create a JSFun with zero arguments; should be equilvant to `syncCallback AlwaysRetain True` in GHCJS
  mkJSFun :: ([JSRef x] -> m (JSRef x)) -> m (JSFun x) --TODO: Support 'this', exceptions
  freeJSFun :: JSFun x -> m ()
  setJSProp :: String -> JSRef x -> JSRef x -> m ()
  getJSProp :: String -> JSRef x -> m (JSRef x)
  withJSNode :: Node -> (JSRef x -> m r) -> m r

#ifdef ghcjs_HOST_OS

data JSCtx_IO
type JS' = JSCtx_IO

instance MonadIO m => HasJS JSCtx_IO (WithJSContextSingleton x m) where
  type JSX (WithJSContextSingleton x m) = IO
  liftJS = liftIO

instance IsJSContext JSCtx_IO where
  newtype JSRef JSCtx_IO = JSRef_IO { unJSRef_IO :: JS.JSVal }

instance MonadJS JSCtx_IO IO where
  runJS (JSFFI f) l = fmap JSRef_IO . f =<< JS.fromListIO (coerce l)
  forkJS = forkIO
  mkJSUndefined = return $ JSRef_IO JS.jsUndefined
  isJSNull (JSRef_IO r) = return $ JS.isNull r
  isJSUndefined (JSRef_IO r) = return $ JS.isUndefined r
  fromJSBool (JSRef_IO r) = return $ JS.fromJSBool r
  fromJSString (JSRef_IO r) = return $ JS.fromJSString $ JS.pFromJSVal r
  fromJSArray (JSRef_IO r) = fmap coerce $ JS.toListIO $ coerce r
  fromJSUint8Array (JSRef_IO r) = fmap (JS.toByteString 0 Nothing . JS.createFromArrayBuffer) $ JSArrayBuffer.unsafeFreeze $ JS.pFromJSVal r --TODO: Assert that this is immutable
  fromJSNumber (JSRef_IO r) = JS.fromJSValUnchecked r
  withJSBool b f = f $ JSRef_IO $ JS.toJSBool b
  withJSString s f = f $ JSRef_IO $ JS.pToJSVal $ JS.toJSString s
  withJSNumber n f = do
    r <- JS.toJSVal n
    f $ JSRef_IO r
  withJSArray l f = do
    r <- JS.fromListIO $ coerce l
    f $ JSRef_IO $ coerce r
  withJSUint8Array payload f = BS.useAsCString payload $ \cStr -> do
    ba <- extractByteArray cStr $ BS.length payload
    f $ JSUint8Array $ JSRef_IO ba
  mkJSFun f = do
    cb <- JS.syncCallback1' $ \args -> do
      l <- JS.toListIO $ coerce args
      JSRef_IO result <- f $ coerce l
      return result
    fmap (JSFun . JSRef_IO) $ funWithArguments $ coerce cb
  freeJSFun (JSFun (JSRef_IO r)) = JS.releaseCallback $ coerce r
  setJSProp s (JSRef_IO v) (JSRef_IO o) = JS.setProp (JS.toJSString s) v $ coerce o
  getJSProp s (JSRef_IO o) = do
    r <- JS.getProp (JS.toJSString s) $ coerce o
    return $ JSRef_IO r
  withJSNode n f = f $ JSRef_IO $ unNode n

foreign import javascript unsafe "new Uint8Array($1_1.buf, $1_2, $2)" extractByteArray :: Ptr CChar -> Int -> IO JS.JSVal

foreign import javascript unsafe "function(){ return $1(arguments); }" funWithArguments :: JS.Callback (JS.MutableJSArray -> IO a) -> IO JS.JSVal

#else

data JSCtx_JavaScriptCore x
type JS' = JSCtx_JavaScriptCore ()

instance IsJSContext (JSCtx_JavaScriptCore x) where
  newtype JSRef (JSCtx_JavaScriptCore x) = JSRef_JavaScriptCore { JSRef (JSCtx_JavaScriptCore x) -> JSVal
unJSRef_JavaScriptCore :: JSVal }

instance MonadIO m => HasJS (JSCtx_JavaScriptCore x) (WithJSContextSingleton x m) where
  type JSX (WithJSContextSingleton x m) = WithJSContextSingleton x IO
  liftJS :: JSX (WithJSContextSingleton x m) a -> WithJSContextSingleton x m a
liftJS JSX (WithJSContextSingleton x m) a
a = do
    JSContextSingleton x
wv <- WithJSContextSingleton x m (JSContextSingleton x)
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext
    IO a -> WithJSContextSingleton x m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> WithJSContextSingleton x m a)
-> IO a -> WithJSContextSingleton x m a
forall a b. (a -> b) -> a -> b
$ WithJSContextSingleton x IO a -> JSContextSingleton x -> IO a
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton JSX (WithJSContextSingleton x m) a
WithJSContextSingleton x IO a
a JSContextSingleton x
wv

newtype WithJSContext x m a = WithJSContext { WithJSContext x m a -> ReaderT JSContextRef m a
unWithJSContext :: ReaderT JSContextRef m a } deriving (a -> WithJSContext x m b -> WithJSContext x m a
(a -> b) -> WithJSContext x m a -> WithJSContext x m b
(forall a b.
 (a -> b) -> WithJSContext x m a -> WithJSContext x m b)
-> (forall a b. a -> WithJSContext x m b -> WithJSContext x m a)
-> Functor (WithJSContext x m)
forall a b. a -> WithJSContext x m b -> WithJSContext x m a
forall a b. (a -> b) -> WithJSContext x m a -> WithJSContext x m b
forall x (m :: * -> *) a b.
Functor m =>
a -> WithJSContext x m b -> WithJSContext x m a
forall x (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithJSContext x m a -> WithJSContext x m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WithJSContext x m b -> WithJSContext x m a
$c<$ :: forall x (m :: * -> *) a b.
Functor m =>
a -> WithJSContext x m b -> WithJSContext x m a
fmap :: (a -> b) -> WithJSContext x m a -> WithJSContext x m b
$cfmap :: forall x (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithJSContext x m a -> WithJSContext x m b
Functor, Functor (WithJSContext x m)
a -> WithJSContext x m a
Functor (WithJSContext x m)
-> (forall a. a -> WithJSContext x m a)
-> (forall a b.
    WithJSContext x m (a -> b)
    -> WithJSContext x m a -> WithJSContext x m b)
-> (forall a b c.
    (a -> b -> c)
    -> WithJSContext x m a
    -> WithJSContext x m b
    -> WithJSContext x m c)
-> (forall a b.
    WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b)
-> (forall a b.
    WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a)
-> Applicative (WithJSContext x m)
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
WithJSContext x m (a -> b)
-> WithJSContext x m a -> WithJSContext x m b
(a -> b -> c)
-> WithJSContext x m a
-> WithJSContext x m b
-> WithJSContext x m c
forall a. a -> WithJSContext x m a
forall a b.
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
forall a b.
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
forall a b.
WithJSContext x m (a -> b)
-> WithJSContext x m a -> WithJSContext x m b
forall a b c.
(a -> b -> c)
-> WithJSContext x m a
-> WithJSContext x m b
-> WithJSContext x m c
forall x (m :: * -> *).
Applicative m =>
Functor (WithJSContext x m)
forall x (m :: * -> *) a. Applicative m => a -> WithJSContext x m a
forall x (m :: * -> *) a b.
Applicative m =>
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
forall x (m :: * -> *) a b.
Applicative m =>
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
forall x (m :: * -> *) a b.
Applicative m =>
WithJSContext x m (a -> b)
-> WithJSContext x m a -> WithJSContext x m b
forall x (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithJSContext x m a
-> WithJSContext x m b
-> WithJSContext x m 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
<* :: WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
$c<* :: forall x (m :: * -> *) a b.
Applicative m =>
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
*> :: WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
$c*> :: forall x (m :: * -> *) a b.
Applicative m =>
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
liftA2 :: (a -> b -> c)
-> WithJSContext x m a
-> WithJSContext x m b
-> WithJSContext x m c
$cliftA2 :: forall x (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithJSContext x m a
-> WithJSContext x m b
-> WithJSContext x m c
<*> :: WithJSContext x m (a -> b)
-> WithJSContext x m a -> WithJSContext x m b
$c<*> :: forall x (m :: * -> *) a b.
Applicative m =>
WithJSContext x m (a -> b)
-> WithJSContext x m a -> WithJSContext x m b
pure :: a -> WithJSContext x m a
$cpure :: forall x (m :: * -> *) a. Applicative m => a -> WithJSContext x m a
$cp1Applicative :: forall x (m :: * -> *).
Applicative m =>
Functor (WithJSContext x m)
Applicative, Applicative (WithJSContext x m)
a -> WithJSContext x m a
Applicative (WithJSContext x m)
-> (forall a b.
    WithJSContext x m a
    -> (a -> WithJSContext x m b) -> WithJSContext x m b)
-> (forall a b.
    WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b)
-> (forall a. a -> WithJSContext x m a)
-> Monad (WithJSContext x m)
WithJSContext x m a
-> (a -> WithJSContext x m b) -> WithJSContext x m b
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
forall a. a -> WithJSContext x m a
forall a b.
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
forall a b.
WithJSContext x m a
-> (a -> WithJSContext x m b) -> WithJSContext x m b
forall x (m :: * -> *). Monad m => Applicative (WithJSContext x m)
forall x (m :: * -> *) a. Monad m => a -> WithJSContext x m a
forall x (m :: * -> *) a b.
Monad m =>
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
forall x (m :: * -> *) a b.
Monad m =>
WithJSContext x m a
-> (a -> WithJSContext x m b) -> WithJSContext x m 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 -> WithJSContext x m a
$creturn :: forall x (m :: * -> *) a. Monad m => a -> WithJSContext x m a
>> :: WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
$c>> :: forall x (m :: * -> *) a b.
Monad m =>
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m b
>>= :: WithJSContext x m a
-> (a -> WithJSContext x m b) -> WithJSContext x m b
$c>>= :: forall x (m :: * -> *) a b.
Monad m =>
WithJSContext x m a
-> (a -> WithJSContext x m b) -> WithJSContext x m b
$cp1Monad :: forall x (m :: * -> *). Monad m => Applicative (WithJSContext x m)
Monad, Monad (WithJSContext x m)
Monad (WithJSContext x m)
-> (forall a. IO a -> WithJSContext x m a)
-> MonadIO (WithJSContext x m)
IO a -> WithJSContext x m a
forall a. IO a -> WithJSContext x m a
forall x (m :: * -> *). MonadIO m => Monad (WithJSContext x m)
forall x (m :: * -> *) a. MonadIO m => IO a -> WithJSContext x m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> WithJSContext x m a
$cliftIO :: forall x (m :: * -> *) a. MonadIO m => IO a -> WithJSContext x m a
$cp1MonadIO :: forall x (m :: * -> *). MonadIO m => Monad (WithJSContext x m)
MonadIO, Monad (WithJSContext x m)
Monad (WithJSContext x m)
-> (forall a. (a -> WithJSContext x m a) -> WithJSContext x m a)
-> MonadFix (WithJSContext x m)
(a -> WithJSContext x m a) -> WithJSContext x m a
forall a. (a -> WithJSContext x m a) -> WithJSContext x m a
forall x (m :: * -> *). MonadFix m => Monad (WithJSContext x m)
forall x (m :: * -> *) a.
MonadFix m =>
(a -> WithJSContext x m a) -> WithJSContext x m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> WithJSContext x m a) -> WithJSContext x m a
$cmfix :: forall x (m :: * -> *) a.
MonadFix m =>
(a -> WithJSContext x m a) -> WithJSContext x m a
$cp1MonadFix :: forall x (m :: * -> *). MonadFix m => Monad (WithJSContext x m)
MonadFix, m a -> WithJSContext x m a
(forall (m :: * -> *) a. Monad m => m a -> WithJSContext x m a)
-> MonadTrans (WithJSContext x)
forall x (m :: * -> *) a. Monad m => m a -> WithJSContext x m a
forall (m :: * -> *) a. Monad m => m a -> WithJSContext x m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> WithJSContext x m a
$clift :: forall x (m :: * -> *) a. Monad m => m a -> WithJSContext x m a
MonadTrans, Monad (WithJSContext x m)
e -> WithJSContext x m a
Monad (WithJSContext x m)
-> (forall e a. Exception e => e -> WithJSContext x m a)
-> (forall e a.
    Exception e =>
    WithJSContext x m a
    -> (e -> WithJSContext x m a) -> WithJSContext x m a)
-> (forall a b.
    WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a)
-> MonadException (WithJSContext x m)
WithJSContext x m a
-> (e -> WithJSContext x m a) -> WithJSContext x m a
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
forall e a. Exception e => e -> WithJSContext x m a
forall e a.
Exception e =>
WithJSContext x m a
-> (e -> WithJSContext x m a) -> WithJSContext x m a
forall a b.
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
forall x (m :: * -> *).
MonadException m =>
Monad (WithJSContext x m)
forall x (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> WithJSContext x m a
forall x (m :: * -> *) e a.
(MonadException m, Exception e) =>
WithJSContext x m a
-> (e -> WithJSContext x m a) -> WithJSContext x m a
forall x (m :: * -> *) a b.
MonadException m =>
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
forall (m :: * -> *).
Monad m
-> (forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
$cfinally :: forall x (m :: * -> *) a b.
MonadException m =>
WithJSContext x m a -> WithJSContext x m b -> WithJSContext x m a
catch :: WithJSContext x m a
-> (e -> WithJSContext x m a) -> WithJSContext x m a
$ccatch :: forall x (m :: * -> *) e a.
(MonadException m, Exception e) =>
WithJSContext x m a
-> (e -> WithJSContext x m a) -> WithJSContext x m a
throw :: e -> WithJSContext x m a
$cthrow :: forall x (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> WithJSContext x m a
$cp1MonadException :: forall x (m :: * -> *).
MonadException m =>
Monad (WithJSContext x m)
MonadException, MonadIO (WithJSContext x m)
MonadException (WithJSContext x m)
MonadIO (WithJSContext x m)
-> MonadException (WithJSContext x m)
-> (forall b.
    ((forall a. WithJSContext x m a -> WithJSContext x m a)
     -> WithJSContext x m b)
    -> WithJSContext x m b)
-> MonadAsyncException (WithJSContext x m)
((forall a. WithJSContext x m a -> WithJSContext x m a)
 -> WithJSContext x m b)
-> WithJSContext x m b
forall b.
((forall a. WithJSContext x m a -> WithJSContext x m a)
 -> WithJSContext x m b)
-> WithJSContext x m b
forall x (m :: * -> *).
MonadAsyncException m =>
MonadIO (WithJSContext x m)
forall x (m :: * -> *).
MonadAsyncException m =>
MonadException (WithJSContext x m)
forall x (m :: * -> *) b.
MonadAsyncException m =>
((forall a. WithJSContext x m a -> WithJSContext x m a)
 -> WithJSContext x m b)
-> WithJSContext x m b
forall (m :: * -> *).
MonadIO m
-> MonadException m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a. WithJSContext x m a -> WithJSContext x m a)
 -> WithJSContext x m b)
-> WithJSContext x m b
$cmask :: forall x (m :: * -> *) b.
MonadAsyncException m =>
((forall a. WithJSContext x m a -> WithJSContext x m a)
 -> WithJSContext x m b)
-> WithJSContext x m b
$cp2MonadAsyncException :: forall x (m :: * -> *).
MonadAsyncException m =>
MonadException (WithJSContext x m)
$cp1MonadAsyncException :: forall x (m :: * -> *).
MonadAsyncException m =>
MonadIO (WithJSContext x m)
MonadAsyncException)

runWithJSContext :: WithJSContext x m a -> JSContextRef -> m a
runWithJSContext :: WithJSContext x m a -> JSContextRef -> m a
runWithJSContext = ReaderT JSContextRef m a -> JSContextRef -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT JSContextRef m a -> JSContextRef -> m a)
-> (WithJSContext x m a -> ReaderT JSContextRef m a)
-> WithJSContext x m a
-> JSContextRef
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithJSContext x m a -> ReaderT JSContextRef m a
forall x (m :: * -> *) a.
WithJSContext x m a -> ReaderT JSContextRef m a
unWithJSContext

instance MonadIO m => MonadJSM (WithJSContextSingleton x m) where
  liftJSM' :: JSM a -> WithJSContextSingleton x m a
liftJSM' JSM a
f = do
    JSContextSingleton x
wv <- WithJSContextSingleton x m (JSContextSingleton x)
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext
    JSM a -> JSContextRef -> WithJSContextSingleton x m a
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
runJSM JSM a
f (JSContextRef -> WithJSContextSingleton x m a)
-> JSContextRef -> WithJSContextSingleton x m a
forall a b. (a -> b) -> a -> b
$ JSContextSingleton x -> JSContextRef
forall x. JSContextSingleton x -> JSContextRef
unJSContextSingleton JSContextSingleton x
wv

instance MonadIO m => MonadJSM (WithJSContext x m) where
  liftJSM' :: JSM a -> WithJSContext x m a
liftJSM' JSM a
f =
    JSM a -> JSContextRef -> WithJSContext x m a
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
runJSM JSM a
f (JSContextRef -> WithJSContext x m a)
-> WithJSContext x m JSContextRef -> WithJSContext x m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT JSContextRef m JSContextRef
-> WithJSContext x m JSContextRef
forall x (m :: * -> *) a.
ReaderT JSContextRef m a -> WithJSContext x m a
WithJSContext ReaderT JSContextRef m JSContextRef
forall r (m :: * -> *). MonadReader r m => m r
ask

lowerWithJSContext :: MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext :: WithJSContext x IO a -> m a
lowerWithJSContext WithJSContext x IO a
a = do
  JSContextRef
c <- m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
  IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ WithJSContext x IO a -> JSContextRef -> IO a
forall x (m :: * -> *) a.
WithJSContext x m a -> JSContextRef -> m a
runWithJSContext WithJSContext x IO a
a JSContextRef
c

liftWithJSContextSingletonThroughWithJSContext :: (HasJSContext m, MonadJSM m, MonadTrans t, Monad m1)
                                    => ((t1 -> t m1 a) -> WithJSContext x IO b)
                                    -> (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a)
                                    -> m b
liftWithJSContextSingletonThroughWithJSContext :: ((t1 -> t m1 a) -> WithJSContext x IO b)
-> (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a) -> m b
liftWithJSContextSingletonThroughWithJSContext (t1 -> t m1 a) -> WithJSContext x IO b
f t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a
a = do
  JSContextSingleton (JSContextPhantom m)
wv <- m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext
  WithJSContext x IO b -> m b
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO b -> m b) -> WithJSContext x IO b -> m b
forall a b. (a -> b) -> a -> b
$ (t1 -> t m1 a) -> WithJSContext x IO b
f ((t1 -> t m1 a) -> WithJSContext x IO b)
-> (t1 -> t m1 a) -> WithJSContext x IO b
forall a b. (a -> b) -> a -> b
$ \t1
b' -> m1 a -> t m1 a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 a -> t m1 a) -> m1 a -> t m1 a
forall a b. (a -> b) -> a -> b
$ WithJSContextSingleton (JSContextPhantom m) m1 a
-> JSContextSingleton (JSContextPhantom m) -> m1 a
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a
a t1
b') JSContextSingleton (JSContextPhantom m)
wv

instance MonadJS (JSCtx_JavaScriptCore x) (WithJSContextSingleton x IO) where
  forkJS :: WithJSContextSingleton x IO ()
-> WithJSContextSingleton x IO ThreadId
forkJS WithJSContextSingleton x IO ()
a = do
    JSContextSingleton x
wv <- WithJSContextSingleton x IO (JSContextSingleton x)
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext
    IO ThreadId -> WithJSContextSingleton x IO ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> WithJSContextSingleton x IO ThreadId)
-> IO ThreadId -> WithJSContextSingleton x IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ WithJSContextSingleton x IO () -> JSContextSingleton x -> IO ()
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton WithJSContextSingleton x IO ()
a JSContextSingleton x
wv
  mkJSFun :: ([JSRef (JSCtx_JavaScriptCore x)]
 -> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x)))
-> WithJSContextSingleton x IO (JSFun (JSCtx_JavaScriptCore x))
mkJSFun [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
a = do
    JSContextSingleton x
wv <- WithJSContextSingleton x IO (JSContextSingleton x)
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext
    WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x))
-> WithJSContextSingleton x IO (JSFun (JSCtx_JavaScriptCore x))
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x))
 -> WithJSContextSingleton x IO (JSFun (JSCtx_JavaScriptCore x)))
-> WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x))
-> WithJSContextSingleton x IO (JSFun (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ ([JSRef (JSCtx_JavaScriptCore x)]
 -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x))
forall x (m :: * -> *).
MonadJS x m =>
([JSRef x] -> m (JSRef x)) -> m (JSFun x)
mkJSFun (([JSRef (JSCtx_JavaScriptCore x)]
  -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
 -> WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x)))
-> ([JSRef (JSCtx_JavaScriptCore x)]
    -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ \[JSRef (JSCtx_JavaScriptCore x)]
args -> IO (JSRef (JSCtx_JavaScriptCore x))
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (JSRef (JSCtx_JavaScriptCore x))
 -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> IO (JSRef (JSCtx_JavaScriptCore x))
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
-> JSContextSingleton x -> IO (JSRef (JSCtx_JavaScriptCore x))
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton ([JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
a [JSRef (JSCtx_JavaScriptCore x)]
args) JSContextSingleton x
wv
  runJS :: JSFFI
-> [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
runJS JSFFI
expr [JSRef (JSCtx_JavaScriptCore x)]
args = WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
-> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
 -> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x)))
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
-> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ JSFFI
-> [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall x (m :: * -> *).
MonadJS x m =>
JSFFI -> [JSRef x] -> m (JSRef x)
runJS JSFFI
expr [JSRef (JSCtx_JavaScriptCore x)]
args
  mkJSUndefined :: WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
mkJSUndefined = WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
-> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall x (m :: * -> *). MonadJS x m => m (JSRef x)
mkJSUndefined
  isJSNull :: JSRef (JSCtx_JavaScriptCore x) -> WithJSContextSingleton x IO Bool
isJSNull = WithJSContext x IO Bool -> WithJSContextSingleton x IO Bool
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO Bool -> WithJSContextSingleton x IO Bool)
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Bool)
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Bool
forall x (m :: * -> *). MonadJS x m => JSRef x -> m Bool
isJSNull
  isJSUndefined :: JSRef (JSCtx_JavaScriptCore x) -> WithJSContextSingleton x IO Bool
isJSUndefined = WithJSContext x IO Bool -> WithJSContextSingleton x IO Bool
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO Bool -> WithJSContextSingleton x IO Bool)
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Bool)
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Bool
forall x (m :: * -> *). MonadJS x m => JSRef x -> m Bool
isJSUndefined
  fromJSBool :: JSRef (JSCtx_JavaScriptCore x) -> WithJSContextSingleton x IO Bool
fromJSBool = WithJSContext x IO Bool -> WithJSContextSingleton x IO Bool
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO Bool -> WithJSContextSingleton x IO Bool)
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Bool)
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Bool
forall x (m :: * -> *). MonadJS x m => JSRef x -> m Bool
fromJSBool
  fromJSString :: JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO String
fromJSString = WithJSContext x IO String -> WithJSContextSingleton x IO String
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO String -> WithJSContextSingleton x IO String)
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO String)
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO String
forall x (m :: * -> *). MonadJS x m => JSRef x -> m String
fromJSString
  fromJSArray :: JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO [JSRef (JSCtx_JavaScriptCore x)]
fromJSArray = WithJSContext x IO [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContextSingleton x IO [JSRef (JSCtx_JavaScriptCore x)]
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO [JSRef (JSCtx_JavaScriptCore x)]
 -> WithJSContextSingleton x IO [JSRef (JSCtx_JavaScriptCore x)])
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContext x IO [JSRef (JSCtx_JavaScriptCore x)])
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO [JSRef (JSCtx_JavaScriptCore x)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO [JSRef (JSCtx_JavaScriptCore x)]
forall x (m :: * -> *). MonadJS x m => JSRef x -> m [JSRef x]
fromJSArray
  fromJSUint8Array :: JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO ByteString
fromJSUint8Array = WithJSContext x IO ByteString
-> WithJSContextSingleton x IO ByteString
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO ByteString
 -> WithJSContextSingleton x IO ByteString)
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContext x IO ByteString)
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO ByteString
forall x (m :: * -> *). MonadJS x m => JSRef x -> m ByteString
fromJSUint8Array
  fromJSNumber :: JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO Double
fromJSNumber = WithJSContext x IO Double -> WithJSContextSingleton x IO Double
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO Double -> WithJSContextSingleton x IO Double)
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Double)
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Double
forall x (m :: * -> *). MonadJS x m => JSRef x -> m Double
fromJSNumber
  freeJSFun :: JSFun (JSCtx_JavaScriptCore x) -> WithJSContextSingleton x IO ()
freeJSFun = WithJSContext x IO () -> WithJSContextSingleton x IO ()
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO () -> WithJSContextSingleton x IO ())
-> (JSFun (JSCtx_JavaScriptCore x) -> WithJSContext x IO ())
-> JSFun (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSFun (JSCtx_JavaScriptCore x) -> WithJSContext x IO ()
forall x (m :: * -> *). MonadJS x m => JSFun x -> m ()
freeJSFun
  withJSBool :: Bool
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
withJSBool = ((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
 -> WithJSContext x IO r)
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall (m :: * -> *) (t :: (* -> *) -> * -> *) (m1 :: * -> *) t1 a
       x b.
(HasJSContext m, MonadJSM m, MonadTrans t, Monad m1) =>
((t1 -> t m1 a) -> WithJSContext x IO b)
-> (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a) -> m b
liftWithJSContextSingletonThroughWithJSContext (((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
  -> WithJSContext x IO r)
 -> (JSRef (JSCtx_JavaScriptCore x)
     -> WithJSContextSingleton x IO r)
 -> WithJSContextSingleton x IO r)
-> (Bool
    -> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
    -> WithJSContext x IO r)
-> Bool
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
forall x (m :: * -> *) r.
MonadJS x m =>
Bool -> (JSRef x -> m r) -> m r
withJSBool
  withJSString :: String
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
withJSString = ((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
 -> WithJSContext x IO r)
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall (m :: * -> *) (t :: (* -> *) -> * -> *) (m1 :: * -> *) t1 a
       x b.
(HasJSContext m, MonadJSM m, MonadTrans t, Monad m1) =>
((t1 -> t m1 a) -> WithJSContext x IO b)
-> (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a) -> m b
liftWithJSContextSingletonThroughWithJSContext (((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
  -> WithJSContext x IO r)
 -> (JSRef (JSCtx_JavaScriptCore x)
     -> WithJSContextSingleton x IO r)
 -> WithJSContextSingleton x IO r)
-> (String
    -> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
    -> WithJSContext x IO r)
-> String
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
forall x (m :: * -> *) r.
MonadJS x m =>
String -> (JSRef x -> m r) -> m r
withJSString
  withJSNumber :: Double
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
withJSNumber = ((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
 -> WithJSContext x IO r)
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall (m :: * -> *) (t :: (* -> *) -> * -> *) (m1 :: * -> *) t1 a
       x b.
(HasJSContext m, MonadJSM m, MonadTrans t, Monad m1) =>
((t1 -> t m1 a) -> WithJSContext x IO b)
-> (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a) -> m b
liftWithJSContextSingletonThroughWithJSContext (((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
  -> WithJSContext x IO r)
 -> (JSRef (JSCtx_JavaScriptCore x)
     -> WithJSContextSingleton x IO r)
 -> WithJSContextSingleton x IO r)
-> (Double
    -> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
    -> WithJSContext x IO r)
-> Double
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
forall x (m :: * -> *) r.
MonadJS x m =>
Double -> (JSRef x -> m r) -> m r
withJSNumber
  withJSArray :: [JSRef (JSCtx_JavaScriptCore x)]
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
withJSArray = ((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
 -> WithJSContext x IO r)
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall (m :: * -> *) (t :: (* -> *) -> * -> *) (m1 :: * -> *) t1 a
       x b.
(HasJSContext m, MonadJSM m, MonadTrans t, Monad m1) =>
((t1 -> t m1 a) -> WithJSContext x IO b)
-> (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a) -> m b
liftWithJSContextSingletonThroughWithJSContext (((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
  -> WithJSContext x IO r)
 -> (JSRef (JSCtx_JavaScriptCore x)
     -> WithJSContextSingleton x IO r)
 -> WithJSContextSingleton x IO r)
-> ([JSRef (JSCtx_JavaScriptCore x)]
    -> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
    -> WithJSContext x IO r)
-> [JSRef (JSCtx_JavaScriptCore x)]
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSRef (JSCtx_JavaScriptCore x)]
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
forall x (m :: * -> *) r.
MonadJS x m =>
[JSRef x] -> (JSRef x -> m r) -> m r
withJSArray
  withJSUint8Array :: ByteString
-> (JSUint8Array (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
withJSUint8Array = ((JSUint8Array (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
 -> WithJSContext x IO r)
-> (JSUint8Array (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall (m :: * -> *) (t :: (* -> *) -> * -> *) (m1 :: * -> *) t1 a
       x b.
(HasJSContext m, MonadJSM m, MonadTrans t, Monad m1) =>
((t1 -> t m1 a) -> WithJSContext x IO b)
-> (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a) -> m b
liftWithJSContextSingletonThroughWithJSContext (((JSUint8Array (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
  -> WithJSContext x IO r)
 -> (JSUint8Array (JSCtx_JavaScriptCore x)
     -> WithJSContextSingleton x IO r)
 -> WithJSContextSingleton x IO r)
-> (ByteString
    -> (JSUint8Array (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
    -> WithJSContext x IO r)
-> ByteString
-> (JSUint8Array (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> (JSUint8Array (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
forall x (m :: * -> *) r.
MonadJS x m =>
ByteString -> (JSUint8Array x -> m r) -> m r
withJSUint8Array
  withJSNode :: Node
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
withJSNode = ((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
 -> WithJSContext x IO r)
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall (m :: * -> *) (t :: (* -> *) -> * -> *) (m1 :: * -> *) t1 a
       x b.
(HasJSContext m, MonadJSM m, MonadTrans t, Monad m1) =>
((t1 -> t m1 a) -> WithJSContext x IO b)
-> (t1 -> WithJSContextSingleton (JSContextPhantom m) m1 a) -> m b
liftWithJSContextSingletonThroughWithJSContext (((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
  -> WithJSContext x IO r)
 -> (JSRef (JSCtx_JavaScriptCore x)
     -> WithJSContextSingleton x IO r)
 -> WithJSContextSingleton x IO r)
-> (Node
    -> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
    -> WithJSContext x IO r)
-> Node
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContextSingleton x IO r)
-> WithJSContextSingleton x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
forall x (m :: * -> *) r.
MonadJS x m =>
Node -> (JSRef x -> m r) -> m r
withJSNode
  setJSProp :: String
-> JSRef (JSCtx_JavaScriptCore x)
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO ()
setJSProp String
propName JSRef (JSCtx_JavaScriptCore x)
valRef JSRef (JSCtx_JavaScriptCore x)
objRef = WithJSContext x IO () -> WithJSContextSingleton x IO ()
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO () -> WithJSContextSingleton x IO ())
-> WithJSContext x IO () -> WithJSContextSingleton x IO ()
forall a b. (a -> b) -> a -> b
$ String
-> JSRef (JSCtx_JavaScriptCore x)
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO ()
forall x (m :: * -> *).
MonadJS x m =>
String -> JSRef x -> JSRef x -> m ()
setJSProp String
propName JSRef (JSCtx_JavaScriptCore x)
valRef JSRef (JSCtx_JavaScriptCore x)
objRef
  getJSProp :: String
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
getJSProp String
propName JSRef (JSCtx_JavaScriptCore x)
objRef = WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
-> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
forall (m :: * -> *) x a. MonadJSM m => WithJSContext x IO a -> m a
lowerWithJSContext (WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
 -> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x)))
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
-> WithJSContextSingleton x IO (JSRef (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ String
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall x (m :: * -> *).
MonadJS x m =>
String -> JSRef x -> m (JSRef x)
getJSProp String
propName JSRef (JSCtx_JavaScriptCore x)
objRef

instance MonadJS (JSCtx_JavaScriptCore x) (WithJSContext x IO) where
  runJS :: JSFFI
-> [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
runJS (JSFFI String
body) [JSRef (JSCtx_JavaScriptCore x)]
args =
    [JSRef (JSCtx_JavaScriptCore x)]
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall x (m :: * -> *) r.
MonadJS x m =>
[JSRef x] -> (JSRef x -> m r) -> m r
withJSArray [JSRef (JSCtx_JavaScriptCore x)]
args ((JSRef (JSCtx_JavaScriptCore x)
  -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
 -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> (JSRef (JSCtx_JavaScriptCore x)
    -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ \(JSRef_JavaScriptCore this) -> do
      JSVal
result <- JSM JSVal -> WithJSContext x IO JSVal
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM JSVal -> WithJSContext x IO JSVal)
-> JSM JSVal -> WithJSContext x IO JSVal
forall a b. (a -> b) -> a -> b
$ String -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (String
"(function(){ return (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
body String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"); })") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> JSVal -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
js1 String
"apply" JSVal
this
      JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall (m :: * -> *) a. Monad m => a -> m a
return (JSRef (JSCtx_JavaScriptCore x)
 -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore JSVal
result
  forkJS :: WithJSContext x IO () -> WithJSContext x IO ThreadId
forkJS WithJSContext x IO ()
a = do
    JSContextRef
c <- WithJSContext x IO JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
    IO ThreadId -> WithJSContext x IO ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> WithJSContext x IO ThreadId)
-> (IO () -> IO ThreadId) -> IO () -> WithJSContext x IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO (IO () -> WithJSContext x IO ThreadId)
-> IO () -> WithJSContext x IO ThreadId
forall a b. (a -> b) -> a -> b
$ WithJSContext x IO () -> JSContextRef -> IO ()
forall x (m :: * -> *) a.
WithJSContext x m a -> JSContextRef -> m a
runWithJSContext WithJSContext x IO ()
a JSContextRef
c
  mkJSUndefined :: WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
mkJSUndefined = JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall (m :: * -> *) a. Monad m => a -> m a
return (JSRef (JSCtx_JavaScriptCore x)
 -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore JSVal
valUndefined
  isJSNull :: JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Bool
isJSNull (JSRef_JavaScriptCore r) = JSM Bool -> WithJSContext x IO Bool
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM Bool -> WithJSContext x IO Bool)
-> JSM Bool -> WithJSContext x IO Bool
forall a b. (a -> b) -> a -> b
$ JSVal -> JSM Bool
forall value. ToJSVal value => value -> JSM Bool
valIsNull JSVal
r
  isJSUndefined :: JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Bool
isJSUndefined (JSRef_JavaScriptCore r) = JSM Bool -> WithJSContext x IO Bool
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM Bool -> WithJSContext x IO Bool)
-> JSM Bool -> WithJSContext x IO Bool
forall a b. (a -> b) -> a -> b
$ JSVal -> JSM Bool
forall value. ToJSVal value => value -> JSM Bool
valIsUndefined JSVal
r
  fromJSBool :: JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Bool
fromJSBool (JSRef_JavaScriptCore r) = JSM Bool -> WithJSContext x IO Bool
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM Bool -> WithJSContext x IO Bool)
-> JSM Bool -> WithJSContext x IO Bool
forall a b. (a -> b) -> a -> b
$ JSVal -> JSM Bool
forall value. ToJSVal value => value -> JSM Bool
valToBool JSVal
r
  fromJSString :: JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO String
fromJSString (JSRef_JavaScriptCore r) = JSM String -> WithJSContext x IO String
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (Text -> String
T.unpack (Text -> String) -> JSM Text -> JSM String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> JSM Text
forall value. ToJSVal value => value -> JSM Text
valToText JSVal
r)
  withJSBool :: Bool
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
withJSBool Bool
b JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
a = JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
a (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
forall a b. (a -> b) -> a -> b
$ JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore (Bool -> JSVal
valBool Bool
b)
  withJSString :: String
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
withJSString String
str JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
a = JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
a (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> (JSVal -> JSRef (JSCtx_JavaScriptCore x))
-> JSVal
-> WithJSContext x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore (JSVal -> WithJSContext x IO r)
-> WithJSContext x IO JSVal -> WithJSContext x IO r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM JSVal -> WithJSContext x IO JSVal
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSString -> JSM JSVal
valMakeString (JSString -> JSM JSVal) -> JSString -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ String -> JSString
forall a. ToJSString a => a -> JSString
toJSString String
str)
  withJSNumber :: Double
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
withJSNumber Double
n JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
a = JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
a (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> (JSVal -> JSRef (JSCtx_JavaScriptCore x))
-> JSVal
-> WithJSContext x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore (JSVal -> WithJSContext x IO r)
-> WithJSContext x IO JSVal -> WithJSContext x IO r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM JSVal -> WithJSContext x IO JSVal
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (Double -> JSM JSVal
valMakeNumber Double
n)
  withJSArray :: [JSRef (JSCtx_JavaScriptCore x)]
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
withJSArray [JSRef (JSCtx_JavaScriptCore x)]
elems JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
a = JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
a (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> (JSVal -> JSRef (JSCtx_JavaScriptCore x))
-> JSVal
-> WithJSContext x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore (JSVal -> WithJSContext x IO r)
-> WithJSContext x IO JSVal -> WithJSContext x IO r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM JSVal -> WithJSContext x IO JSVal
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM
    (Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (Object -> JSM JSVal) -> JSM Object -> JSM JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [JSVal] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array ((JSRef (JSCtx_JavaScriptCore x) -> JSVal)
-> [JSRef (JSCtx_JavaScriptCore x)] -> [JSVal]
forall a b. (a -> b) -> [a] -> [b]
map (\(JSRef_JavaScriptCore r) -> JSVal
r) [JSRef (JSCtx_JavaScriptCore x)]
elems))
  withJSUint8Array :: ByteString
-> (JSUint8Array (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
withJSUint8Array ByteString
payload JSUint8Array (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
f = [Word8]
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
forall x a (m :: * -> *) r.
(ToJS x a, MonadJS x m) =>
[a] -> (JSRef x -> m r) -> m r
withJSArrayFromList (ByteString -> [Word8]
BS.unpack ByteString
payload) ((JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
 -> WithJSContext x IO r)
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
forall a b. (a -> b) -> a -> b
$ \JSRef (JSCtx_JavaScriptCore x)
x -> do
    JSRef (JSCtx_JavaScriptCore x)
payloadRef <- JSFFI
-> [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall x (m :: * -> *).
MonadJS x m =>
JSFFI -> [JSRef x] -> m (JSRef x)
runJS (String -> JSFFI
JSFFI String
"new Uint8Array(this[0])") [JSRef (JSCtx_JavaScriptCore x)
x]
    JSUint8Array (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
f (JSUint8Array (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> JSUint8Array (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
forall a b. (a -> b) -> a -> b
$ JSRef (JSCtx_JavaScriptCore x)
-> JSUint8Array (JSCtx_JavaScriptCore x)
forall x. JSRef x -> JSUint8Array x
JSUint8Array JSRef (JSCtx_JavaScriptCore x)
payloadRef
  fromJSArray :: JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO [JSRef (JSCtx_JavaScriptCore x)]
fromJSArray (JSRef_JavaScriptCore a) = JSM [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContext x IO [JSRef (JSCtx_JavaScriptCore x)]
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM [JSRef (JSCtx_JavaScriptCore x)]
 -> WithJSContext x IO [JSRef (JSCtx_JavaScriptCore x)])
-> JSM [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContext x IO [JSRef (JSCtx_JavaScriptCore x)]
forall a b. (a -> b) -> a -> b
$ do
    Key
len <- Double -> Key
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Key) -> JSM Double -> JSM Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber (JSVal -> JSM Double) -> JSM JSVal -> JSM Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JSVal
a JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"length"))
    [Key]
-> (Key -> JSM (JSRef (JSCtx_JavaScriptCore x)))
-> JSM [JSRef (JSCtx_JavaScriptCore x)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Key
0..Key
lenKey -> Key -> Key
forall a. Num a => a -> a -> a
-Key
1] ((Key -> JSM (JSRef (JSCtx_JavaScriptCore x)))
 -> JSM [JSRef (JSCtx_JavaScriptCore x)])
-> (Key -> JSM (JSRef (JSCtx_JavaScriptCore x)))
-> JSM [JSRef (JSCtx_JavaScriptCore x)]
forall a b. (a -> b) -> a -> b
$ (JSVal -> JSRef (JSCtx_JavaScriptCore x))
-> JSM JSVal -> JSM (JSRef (JSCtx_JavaScriptCore x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore (JSM JSVal -> JSM (JSRef (JSCtx_JavaScriptCore x)))
-> (Key -> JSM JSVal)
-> Key
-> JSM (JSRef (JSCtx_JavaScriptCore x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSVal
a JSVal -> Key -> JSM JSVal
forall this. MakeObject this => this -> Key -> JSM JSVal
!!)
  fromJSUint8Array :: JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO ByteString
fromJSUint8Array JSRef (JSCtx_JavaScriptCore x)
a = do
    [JSRef (JSCtx_JavaScriptCore x)]
vals <- JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO [JSRef (JSCtx_JavaScriptCore x)]
forall x (m :: * -> *). MonadJS x m => JSRef x -> m [JSRef x]
fromJSArray JSRef (JSCtx_JavaScriptCore x)
a
    [Double]
doubles <- (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Double)
-> [JSRef (JSCtx_JavaScriptCore x)] -> WithJSContext x IO [Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Double
forall x (m :: * -> *). MonadJS x m => JSRef x -> m Double
fromJSNumber [JSRef (JSCtx_JavaScriptCore x)]
vals
    ByteString -> WithJSContext x IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> WithJSContext x IO ByteString)
-> ByteString -> WithJSContext x IO ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Double -> Word8) -> [Double] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
round [Double]
doubles
  fromJSNumber :: JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO Double
fromJSNumber (JSRef_JavaScriptCore val) = JSM Double -> WithJSContext x IO Double
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM Double -> WithJSContext x IO Double)
-> JSM Double -> WithJSContext x IO Double
forall a b. (a -> b) -> a -> b
$ JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber JSVal
val
  mkJSFun :: ([JSRef (JSCtx_JavaScriptCore x)]
 -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x))
mkJSFun [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
a = JSM (JSFun (JSCtx_JavaScriptCore x))
-> WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x))
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (JSFun (JSCtx_JavaScriptCore x))
 -> WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x)))
-> JSM (JSFun (JSCtx_JavaScriptCore x))
-> WithJSContext x IO (JSFun (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ do
    JSContextRef
ctx <- JSM JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
    Function
f <- JSCallAsFunction -> JSM Function
function (JSCallAsFunction -> JSM Function)
-> JSCallAsFunction -> JSM Function
forall a b. (a -> b) -> a -> b
$ \JSVal
_ JSVal
_ [JSVal]
args -> IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IO (JSRef (JSCtx_JavaScriptCore x)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (JSRef (JSCtx_JavaScriptCore x)) -> IO ())
-> IO (JSRef (JSCtx_JavaScriptCore x)) -> IO ()
forall a b. (a -> b) -> a -> b
$ WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
-> JSContextRef -> IO (JSRef (JSCtx_JavaScriptCore x))
forall x (m :: * -> *) a.
WithJSContext x m a -> JSContextRef -> m a
runWithJSContext ([JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
a ([JSRef (JSCtx_JavaScriptCore x)]
 -> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x)))
-> [JSRef (JSCtx_JavaScriptCore x)]
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ (JSVal -> JSRef (JSCtx_JavaScriptCore x))
-> [JSVal] -> [JSRef (JSCtx_JavaScriptCore x)]
forall a b. (a -> b) -> [a] -> [b]
map JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore [JSVal]
args) JSContextRef
ctx
    JSVal
fRef <- Function -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Function
f
    JSFun (JSCtx_JavaScriptCore x)
-> JSM (JSFun (JSCtx_JavaScriptCore x))
forall (m :: * -> *) a. Monad m => a -> m a
return (JSFun (JSCtx_JavaScriptCore x)
 -> JSM (JSFun (JSCtx_JavaScriptCore x)))
-> JSFun (JSCtx_JavaScriptCore x)
-> JSM (JSFun (JSCtx_JavaScriptCore x))
forall a b. (a -> b) -> a -> b
$ JSRef (JSCtx_JavaScriptCore x)
-> Function -> JSFun (JSCtx_JavaScriptCore x)
forall x. JSRef x -> Function -> JSFun x
JSFun (JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore JSVal
fRef) Function
f
  freeJSFun :: JSFun (JSCtx_JavaScriptCore x) -> WithJSContext x IO ()
freeJSFun (JSFun JSRef (JSCtx_JavaScriptCore x)
_ Function
f) = JSM () -> WithJSContext x IO ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> WithJSContext x IO ())
-> JSM () -> WithJSContext x IO ()
forall a b. (a -> b) -> a -> b
$ Function -> JSM ()
freeFunction Function
f
  setJSProp :: String
-> JSRef (JSCtx_JavaScriptCore x)
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO ()
setJSProp String
propName (JSRef_JavaScriptCore valRef) (JSRef_JavaScriptCore objRef) =
    JSM () -> WithJSContext x IO ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> WithJSContext x IO ())
-> JSM () -> WithJSContext x IO ()
forall a b. (a -> b) -> a -> b
$ JSVal
objRef JSVal -> Getting (JSM ()) JSVal (JSM ()) -> JSM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (JSM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (JSM ())
jss String
propName JSVal
valRef
  getJSProp :: String
-> JSRef (JSCtx_JavaScriptCore x)
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
getJSProp String
propName (JSRef_JavaScriptCore objRef) =
    JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore (JSVal -> JSRef (JSCtx_JavaScriptCore x))
-> WithJSContext x IO JSVal
-> WithJSContext x IO (JSRef (JSCtx_JavaScriptCore x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> WithJSContext x IO JSVal
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSVal
objRef JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
propName)
  withJSNode :: Node
-> (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> WithJSContext x IO r
withJSNode Node
n JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
f = JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r
f (JSRef (JSCtx_JavaScriptCore x) -> WithJSContext x IO r)
-> (JSVal -> JSRef (JSCtx_JavaScriptCore x))
-> JSVal
-> WithJSContext x IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSRef (JSCtx_JavaScriptCore x)
forall x. JSVal -> JSRef (JSCtx_JavaScriptCore x)
JSRef_JavaScriptCore (JSVal -> WithJSContext x IO r)
-> WithJSContext x IO JSVal -> WithJSContext x IO r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM JSVal -> WithJSContext x IO JSVal
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (Node -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Node
n)

#endif

class FromJS x a where
  fromJS :: MonadJS x m => JSRef x -> m a

instance FromJS x () where
  fromJS :: JSRef x -> m ()
fromJS JSRef x
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO: Should this do some kind of checking for the js value?

instance FromJS x Bool where
  fromJS :: JSRef x -> m Bool
fromJS = JSRef x -> m Bool
forall x (m :: * -> *). MonadJS x m => JSRef x -> m Bool
fromJSBool

instance ToJS x Bool where
  withJS :: Bool -> (JSRef x -> m r) -> m r
withJS = Bool -> (JSRef x -> m r) -> m r
forall x (m :: * -> *) r.
MonadJS x m =>
Bool -> (JSRef x -> m r) -> m r
withJSBool

instance FromJS x String where
  fromJS :: JSRef x -> m String
fromJS = JSRef x -> m String
forall x (m :: * -> *). MonadJS x m => JSRef x -> m String
fromJSString

instance FromJS x Text where
  fromJS :: JSRef x -> m Text
fromJS JSRef x
s = String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSRef x -> m String
forall x (m :: * -> *). MonadJS x m => JSRef x -> m String
fromJSString JSRef x
s

instance FromJS x a => FromJS x (Maybe a) where
  fromJS :: JSRef x -> m (Maybe a)
fromJS JSRef x
x = do
    Bool
n <- JSRef x -> m Bool
forall x (m :: * -> *). MonadJS x m => JSRef x -> m Bool
isJSNull JSRef x
x
    if Bool
n then Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSRef x -> m a
forall x a (m :: * -> *).
(FromJS x a, MonadJS x m) =>
JSRef x -> m a
fromJS JSRef x
x

class ToJS x a where
  withJS :: MonadJS x m => a -> (JSRef x -> m r) -> m r

instance ToJS x (JSRef x) where
  withJS :: JSRef x -> (JSRef x -> m r) -> m r
withJS JSRef x
r = ((JSRef x -> m r) -> JSRef x -> m r
forall a b. (a -> b) -> a -> b
$ JSRef x
r)

instance FromJS x (JSRef x) where
  fromJS :: JSRef x -> m (JSRef x)
fromJS = JSRef x -> m (JSRef x)
forall (m :: * -> *) a. Monad m => a -> m a
return

instance ToJS x String where
  withJS :: String -> (JSRef x -> m r) -> m r
withJS = String -> (JSRef x -> m r) -> m r
forall x (m :: * -> *) r.
MonadJS x m =>
String -> (JSRef x -> m r) -> m r
withJSString

instance ToJS x Text where
  withJS :: Text -> (JSRef x -> m r) -> m r
withJS = String -> (JSRef x -> m r) -> m r
forall x (m :: * -> *) r.
MonadJS x m =>
String -> (JSRef x -> m r) -> m r
withJSString (String -> (JSRef x -> m r) -> m r)
-> (Text -> String) -> Text -> (JSRef x -> m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

newtype JSArray a = JSArray { JSArray a -> [a]
unJSArray :: [a] }

instance ToJS x a => ToJS x (JSArray a) where
  withJS :: JSArray a -> (JSRef x -> m r) -> m r
withJS = [a] -> (JSRef x -> m r) -> m r
forall x a (m :: * -> *) r.
(ToJS x a, MonadJS x m) =>
[a] -> (JSRef x -> m r) -> m r
withJSArrayFromList ([a] -> (JSRef x -> m r) -> m r)
-> (JSArray a -> [a]) -> JSArray a -> (JSRef x -> m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSArray a -> [a]
forall a. JSArray a -> [a]
unJSArray

instance FromJS x a => FromJS x (JSArray a) where
  fromJS :: JSRef x -> m (JSArray a)
fromJS = ([a] -> JSArray a) -> m [a] -> m (JSArray a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> JSArray a
forall a. [a] -> JSArray a
JSArray (m [a] -> m (JSArray a))
-> ([JSRef x] -> m [a]) -> [JSRef x] -> m (JSArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSRef x -> m a) -> [JSRef x] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JSRef x -> m a
forall x a (m :: * -> *).
(FromJS x a, MonadJS x m) =>
JSRef x -> m a
fromJS ([JSRef x] -> m (JSArray a))
-> (JSRef x -> m [JSRef x]) -> JSRef x -> m (JSArray a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSRef x -> m [JSRef x]
forall x (m :: * -> *). MonadJS x m => JSRef x -> m [JSRef x]
fromJSArray

withJSArrayFromList :: (ToJS x a, MonadJS x m) => [a] -> (JSRef x -> m r) -> m r
withJSArrayFromList :: [a] -> (JSRef x -> m r) -> m r
withJSArrayFromList [a]
as JSRef x -> m r
f = [a] -> [JSRef x] -> m r
go [a]
as []
  where go :: [a] -> [JSRef x] -> m r
go [] [JSRef x]
jsRefs = [JSRef x] -> (JSRef x -> m r) -> m r
forall x (m :: * -> *) r.
MonadJS x m =>
[JSRef x] -> (JSRef x -> m r) -> m r
withJSArray ([JSRef x] -> [JSRef x]
forall a. [a] -> [a]
reverse [JSRef x]
jsRefs) JSRef x -> m r
f
        go (a
h:[a]
t) [JSRef x]
jsRefs = a -> (JSRef x -> m r) -> m r
forall x a (m :: * -> *) r.
(ToJS x a, MonadJS x m) =>
a -> (JSRef x -> m r) -> m r
withJS a
h ((JSRef x -> m r) -> m r) -> (JSRef x -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \JSRef x
hRef -> [a] -> [JSRef x] -> m r
go [a]
t (JSRef x
hRef JSRef x -> [JSRef x] -> [JSRef x]
forall a. a -> [a] -> [a]
: [JSRef x]
jsRefs)

newtype JSUint8Array x = JSUint8Array { JSUint8Array x -> JSRef x
unJSUint8Array :: JSRef x }

instance ToJS x (JSUint8Array x) where
  withJS :: JSUint8Array x -> (JSRef x -> m r) -> m r
withJS (JSUint8Array JSRef x
r) = ((JSRef x -> m r) -> JSRef x -> m r
forall a b. (a -> b) -> a -> b
$ JSRef x
r)

instance FromJS x (JSUint8Array x) where
  fromJS :: JSRef x -> m (JSUint8Array x)
fromJS = JSUint8Array x -> m (JSUint8Array x)
forall (m :: * -> *) a. Monad m => a -> m a
return (JSUint8Array x -> m (JSUint8Array x))
-> (JSRef x -> JSUint8Array x) -> JSRef x -> m (JSUint8Array x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRef x -> JSUint8Array x
forall x. JSRef x -> JSUint8Array x
JSUint8Array

instance ToJS x Word8 where
  withJS :: Word8 -> (JSRef x -> m r) -> m r
withJS Word8
n = Double -> (JSRef x -> m r) -> m r
forall x (m :: * -> *) r.
MonadJS x m =>
Double -> (JSRef x -> m r) -> m r
withJSNumber (Double -> (JSRef x -> m r) -> m r)
-> Double -> (JSRef x -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n --TODO: Check things; throw exceptions

instance ToJS x Int where
  withJS :: Key -> (JSRef x -> m r) -> m r
withJS Key
n = Double -> (JSRef x -> m r) -> m r
forall x (m :: * -> *) r.
MonadJS x m =>
Double -> (JSRef x -> m r) -> m r
withJSNumber (Double -> (JSRef x -> m r) -> m r)
-> Double -> (JSRef x -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ Key -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
n --TODO: Check things; throw exceptions

instance FromJS x Int where
  fromJS :: JSRef x -> m Key
fromJS = (Double -> Key) -> m Double -> m Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Key
forall a b. (RealFrac a, Integral b) => a -> b
round (m Double -> m Key) -> (JSRef x -> m Double) -> JSRef x -> m Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRef x -> m Double
forall x (m :: * -> *). MonadJS x m => JSRef x -> m Double
fromJSNumber --TODO: Check things; throw exceptions

instance ToJS x Double where
  withJS :: Double -> (JSRef x -> m r) -> m r
withJS = Double -> (JSRef x -> m r) -> m r
forall x (m :: * -> *) r.
MonadJS x m =>
Double -> (JSRef x -> m r) -> m r
withJSNumber

instance FromJS x Double where
  fromJS :: JSRef x -> m Double
fromJS = JSRef x -> m Double
forall x (m :: * -> *). MonadJS x m => JSRef x -> m Double
fromJSNumber

instance ToJS x Node where
  withJS :: Node -> (JSRef x -> m r) -> m r
withJS = Node -> (JSRef x -> m r) -> m r
forall x (m :: * -> *) r.
MonadJS x m =>
Node -> (JSRef x -> m r) -> m r
withJSNode


#ifdef USE_TEMPLATE_HASKELL

importJS :: Safety -> String -> String -> Q Type -> Q [Dec]
importJS :: Safety -> String -> String -> Q Type -> Q [Dec]
importJS Safety
safety String
body String
name Q Type
qt = do
  Type
t <- Q Type
qt
  let ([Type]
argTypes, Type
_) = Type -> ([Type], Type)
parseType Type
t
  [(Name, Name)]
argNames <- [Type] -> (Type -> Q (Name, Name)) -> Q [(Name, Name)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Type]
argTypes ((Type -> Q (Name, Name)) -> Q [(Name, Name)])
-> (Type -> Q (Name, Name)) -> Q [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ \Type
_ -> do
    Name
arg <- String -> Q Name
newName String
"arg"
    Name
argRef <- String -> Q Name
newName String
"argRef"
    (Name, Name) -> Q (Name, Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
arg, Name
argRef)
  ([Dec]
jsffiDecs, Exp
jsffiExp) <- Safety -> String -> Q ([Dec], Exp)
mkJSFFI Safety
safety String
body
  let go :: [(Name, Name)] -> ExpQ
go [] = [| runJS $(return jsffiExp) $(listE $ map (varE . snd) argNames) >>= fromJS
               |]
      go ((Name
arg, Name
argRef) : [(Name, Name)]
args) = [| withJS $(varE arg) $ $(lamE [varP argRef] $ go args) |]
  Exp
e <- [PatQ] -> ExpQ -> ExpQ
lamE (((Name, Name) -> PatQ) -> [(Name, Name)] -> [PatQ]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> PatQ
varP(Name -> PatQ) -> ((Name, Name) -> Name) -> (Name, Name) -> PatQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Name) -> Name
forall a b. (a, b) -> a
fst) [(Name, Name)]
argNames) (ExpQ -> ExpQ) -> ExpQ -> ExpQ
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> ExpQ
go [(Name, Name)]
argNames
  let n :: Name
n = String -> Name
mkName String
name
  [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec]
jsffiDecs [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++
    [ Name -> Type -> Dec
SigD Name
n Type
t
    , Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP Name
n) (Exp -> Body
NormalB Exp
e) []
    ]

mkJSFFI :: Safety -> String -> Q ([Dec], Exp)
#ifdef ghcjs_HOST_OS
mkJSFFI safety body = do
  -- n <- newName "jsffi" --TODO: Should use newName, but that doesn't seem to work with ghcjs
  l <- location
  n <- newName $ "jsffi_" <> zEncodeString (loc_package l <> ":" <> loc_module l) <> "_" <> show (abs (hash (show safety, body)))
  t <- [t| JSFFI_Internal |]
  let wrappedBody = "(function(){ return (" <> body <> "); }).apply($1)"
  let decs = [ForeignD $ ImportF JavaScript safety wrappedBody n t]
  e <- [| JSFFI $(varE n) |]
  return (decs, e)
#else
mkJSFFI :: Safety -> String -> Q ([Dec], Exp)
mkJSFFI Safety
_ String
body = do
  Exp
e <- [| JSFFI body |]
  ([Dec], Exp) -> Q ([Dec], Exp)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Exp
e)
#endif

parseType :: Type -> ([Type], Type)
parseType :: Type -> ([Type], Type)
parseType (ForallT [TyVarBndr]
_ [AppT (AppT (ConT Name
monadJs) (VarT Name
_)) (VarT Name
m)] Type
funType)
  | Name
monadJs Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''MonadJS = Type -> ([Type], Type)
go Type
funType
  where go :: Type -> ([Type], Type)
go Type
t = case Type
t of
          AppT (AppT Type
ArrowT Type
arg) Type
t' ->
            let ([Type]
args, Type
result) = Type -> ([Type], Type)
go Type
t'
            in (Type
arg Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type]
args, Type
result)
          AppT (VarT Name
m') Type
result
            | Name
m' Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
m -> ([], Type
result)
          Type
_ -> String -> ([Type], Type)
forall a. HasCallStack => String -> a
error (String -> ([Type], Type)) -> String -> ([Type], Type)
forall a b. (a -> b) -> a -> b
$ String
"parseType: can't parse type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Type -> String
forall a. Show a => a -> String
show Type
t
parseType Type
t = String -> ([Type], Type)
forall a. HasCallStack => String -> a
error (String -> ([Type], Type)) -> String -> ([Type], Type)
forall a b. (a -> b) -> a -> b
$ String
"parseType: can't parse type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Type -> String
forall a. Show a => a -> String
show Type
t

#endif