#ifdef ghcjs_HOST_OS
#else
#endif
module Language.Javascript.JSaddle.Types (
JSContextRef(..)
, JSM(..)
, MonadJSM(..)
, liftJSM
, JSVal(..)
, 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 (MutableJSArray)
import Data.Word (Word(..))
import GHCJS.Nullable (Nullable(..))
#else
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.Int (Int64)
import Data.Text (Text)
import Data.Time.Clock (UTCTime(..))
import Data.Aeson
(defaultOptions, genericToEncoding, ToJSON(..), FromJSON(..))
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
runJSM :: JSM a -> JSContextRef -> IO a
runJSM f = const f
#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)
newtype MutableJSArray = MutableJSArray JSValueRef deriving(Show, ToJSON, FromJSON)
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
| 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
| 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
| 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