#ifdef ghcjs_HOST_OS
#else
#endif
module Language.Javascript.JSaddle.Types (
JSContextRef(..)
, JSM(..)
, MonadJSM(..)
, liftJSM
, JSVal(..)
, SomeJSArray(..)
, JSArray
, MutableJSArray
, Object(..)
, JSString(..)
, Nullable(..)
, JSCallAsFunction
#ifndef ghcjs_HOST_OS
, JSValueReceived(..)
, JSValueForSend(..)
, JSStringReceived(..)
, JSStringForSend(..)
, JSObjectForSend(..)
, AsyncCommand(..)
, Command(..)
, Batch(..)
, Result(..)
#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)
import GHCJS.Nullable (Nullable(..))
#else
import Control.DeepSeq (NFData(..))
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State.Lazy (StateT(..))
import qualified Control.Monad.Trans.State.Strict as Strict
(StateT(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Fix (MonadFix)
import Control.Monad.Ref (MonadAtomicRef(..), MonadRef(..))
import Control.Concurrent.STM.TVar (TVar)
import Data.Coerce (Coercible, coerce)
import Data.Int (Int64)
import Data.Text (Text)
import Data.Time.Clock (UTCTime(..))
import Data.Typeable (Typeable)
import Data.Aeson
(defaultOptions, genericToEncoding, ToJSON(..), FromJSON(..), Value)
import GHC.Generics (Generic)
#endif
#ifdef ghcjs_HOST_OS
type JSContextRef = ()
#else
data JSContextRef = JSContextRef {
startTime :: UTCTime
, doSendCommand :: Command -> IO Result
, doSendAsyncCommand :: AsyncCommand -> IO ()
, addCallback :: Object -> JSCallAsFunction -> IO ()
, freeCallback :: Object -> IO ()
, nextRef :: TVar JSValueRef
}
#endif
#ifdef ghcjs_HOST_OS
type JSM = IO
#else
newtype JSM a = JSM { unJSM :: ReaderT JSContextRef IO a }
deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
#endif
#ifdef ghcjs_HOST_OS
type MonadJSM = MonadIO
#else
class (Applicative m, MonadIO m) => MonadJSM m where
liftJSM' :: JSM a -> m a
instance MonadJSM JSM where
liftJSM' = id
instance MonadJSM m => MonadJSM (ReaderT e m) where
liftJSM' = lift . liftJSM'
instance MonadJSM m => MonadJSM (StateT r m) where
liftJSM' = lift . liftJSM'
instance MonadJSM m => MonadJSM (Strict.StateT r m) where
liftJSM' = lift . liftJSM'
instance MonadRef JSM where
type Ref JSM = Ref IO
newRef = liftIO . newRef
readRef = liftIO . readRef
writeRef r = liftIO . writeRef r
instance MonadAtomicRef JSM where
atomicModifyRef r = liftIO . atomicModifyRef r
#endif
liftJSM :: MonadJSM m => JSM a -> m a
#ifdef ghcjs_HOST_OS
liftJSM = liftIO
#else
liftJSM = liftJSM'
#endif
type JSCallAsFunction = JSVal
-> JSVal
-> [JSVal]
-> JSM ()
#ifndef ghcjs_HOST_OS
type JSValueRef = Int64
newtype JSVal = JSVal JSValueRef deriving(Show, ToJSON, FromJSON)
instance NFData JSVal where
rnf x = x `seq` ()
class IsJSVal a where
jsval_ :: a -> JSVal
default jsval_ :: Coercible a JSVal => a -> JSVal
jsval_ = coerce
jsval :: IsJSVal a => a -> JSVal
jsval = 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)
type JSArray = SomeJSArray Immutable
type MutableJSArray = SomeJSArray Mutable
newtype Object = Object JSVal deriving(Show, ToJSON, FromJSON)
newtype Nullable a = Nullable a
newtype JSString = JSString Text deriving(Show, ToJSON, FromJSON)
newtype JSValueReceived = JSValueReceived JSValueRef deriving(Show, ToJSON, FromJSON)
newtype JSValueForSend = JSValueForSend JSValueRef deriving(Show, ToJSON, FromJSON)
newtype JSObjectForSend = JSObjectForSend JSValueForSend deriving(Show, ToJSON, FromJSON)
newtype JSStringReceived = JSStringReceived Text deriving(Show, ToJSON, FromJSON)
newtype JSStringForSend = JSStringForSend Text deriving(Show, ToJSON, FromJSON)
data AsyncCommand = FreeRef JSValueForSend
| 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
| NewCallback JSValueForSend
| NewArray [JSValueForSend] JSValueForSend
| EvaluateScript JSStringForSend JSValueForSend
| SyncWithAnimationFrame JSValueForSend
deriving (Show, Generic)
instance ToJSON AsyncCommand where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AsyncCommand
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 (Show, Generic)
instance ToJSON Command where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Command
data Batch = Batch [AsyncCommand] Command Bool
deriving (Show, Generic)
instance ToJSON Batch where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Batch
data Result = DeRefValResult JSValueRef Text
| ValueToBoolResult Bool
| ValueToNumberResult Double
| ValueToStringResult JSStringReceived
| ValueToJSONResult JSStringReceived
| ValueToJSONValueResult Value
| IsNullResult Bool
| IsUndefinedResult Bool
| StrictEqualResult Bool
| InstanceOfResult Bool
| Callback JSValueReceived JSValueReceived [JSValueReceived]
| PropertyNamesResult [JSStringReceived]
| ThrowJSValue JSValueReceived
| ProtocolError Text
| SyncResult
deriving (Show, Generic)
instance ToJSON Result where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Result
#endif