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

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

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

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

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

  -- * Debugging
  , JSadddleHasCallStack

  -- * Sync JSM
  , syncPoint
  , syncAfter

#ifndef ghcjs_HOST_OS
  , sendCommand

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

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

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

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

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

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

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

#endif

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

#ifndef ghcjs_HOST_OS

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

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

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

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

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

data IsItMutable = IsImmutable
                 | IsMutable

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

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

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

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

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

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

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

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

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

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

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

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

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

instance FromJSON AsyncCommand

instance NFData AsyncCommand

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

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

instance FromJSON Command

instance NFData Command

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

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

instance FromJSON Batch

instance NFData Batch

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

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

instance FromJSON Result

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

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

instance FromJSON BatchResults

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

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

instance FromJSON Results
#endif

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