ghcjs-base-0.2.0.0: GHCJS/Marshal/Pure.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE JavaScriptFFI #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-
experimental pure marshalling for lighter weight interaction in the quasiquoter
-}
module GHCJS.Marshal.Pure ( PFromJSVal(..)
, PToJSVal(..)
) where
import Data.Char (chr, ord)
import Data.Data
import Data.Int (Int8, Int16, Int32)
import Data.JSString.Internal.Type
import Data.Maybe
import Data.Text (Text)
import Data.Typeable
import Data.Word (Word8, Word16, Word32, Word)
import Data.JSString
import Data.JSString.Text
import Data.Bits ((.&.))
import Unsafe.Coerce (unsafeCoerce)
import GHC.Int
import GHC.Word
import GHC.Types
import GHC.Float
import GHC.Prim
import GHCJS.Types
import qualified GHCJS.Prim as Prim
import GHCJS.Foreign.Internal
import GHCJS.Marshal.Internal
{-
type family IsPureShared a where
IsPureShared PureExclusive = False
IsPureShared PureShared = True
type family IsPureExclusive a where
IsPureExclusive PureExclusive = True
IsPureExclusive PureShared = True
-}
instance PFromJSVal JSVal where pFromJSVal = id
{-# INLINE pFromJSVal #-}
instance PFromJSVal () where pFromJSVal _ = ()
{-# INLINE pFromJSVal #-}
instance PFromJSVal JSString where pFromJSVal = JSString
{-# INLINE pFromJSVal #-}
instance PFromJSVal [Char] where pFromJSVal = Prim.fromJSString
{-# INLINE pFromJSVal #-}
instance PFromJSVal Text where pFromJSVal = textFromJSVal
{-# INLINE pFromJSVal #-}
instance PFromJSVal Char where pFromJSVal x = C# (jsvalToChar x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Bool where pFromJSVal = isTruthy
{-# INLINE pFromJSVal #-}
instance PFromJSVal Int where pFromJSVal x = I# (jsvalToInt x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Int8 where pFromJSVal x = I8# (jsvalToInt8 x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Int16 where pFromJSVal x = I16# (jsvalToInt16 x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Int32 where pFromJSVal x = I32# (jsvalToInt x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Word where pFromJSVal x = W# (jsvalToWord x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Word8 where pFromJSVal x = W8# (jsvalToWord8 x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Word16 where pFromJSVal x = W16# (jsvalToWord16 x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Word32 where pFromJSVal x = W32# (jsvalToWord x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Float where pFromJSVal x = F# (jsvalToFloat x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal Double where pFromJSVal x = D# (jsvalToDouble x)
{-# INLINE pFromJSVal #-}
instance PFromJSVal a => PFromJSVal (Maybe a) where
pFromJSVal x | isUndefined x || isNull x = Nothing
pFromJSVal x = Just (pFromJSVal x)
{-# INLINE pFromJSVal #-}
instance PToJSVal JSVal where pToJSVal = id
{-# INLINE pToJSVal #-}
instance PToJSVal JSString where pToJSVal = jsval
{-# INLINE pToJSVal #-}
instance PToJSVal [Char] where pToJSVal = Prim.toJSString
{-# INLINE pToJSVal #-}
instance PToJSVal Text where pToJSVal = jsval . textToJSString
{-# INLINE pToJSVal #-}
instance PToJSVal Char where pToJSVal (C# c) = charToJSVal c
{-# INLINE pToJSVal #-}
instance PToJSVal Bool where pToJSVal True = jsTrue
pToJSVal False = jsFalse
{-# INLINE pToJSVal #-}
instance PToJSVal Int where pToJSVal (I# x) = intToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal Int8 where pToJSVal (I8# x) = intToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal Int16 where pToJSVal (I16# x) = intToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal Int32 where pToJSVal (I32# x) = intToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal Word where pToJSVal (W# x) = wordToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal Word8 where pToJSVal (W8# x) = wordToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal Word16 where pToJSVal (W16# x) = wordToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal Word32 where pToJSVal (W32# x) = wordToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal Float where pToJSVal (F# x) = floatToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal Double where pToJSVal (D# x) = doubleToJSVal x
{-# INLINE pToJSVal #-}
instance PToJSVal a => PToJSVal (Maybe a) where
pToJSVal Nothing = jsNull
pToJSVal (Just a) = pToJSVal a
{-# INLINE pToJSVal #-}
foreign import javascript unsafe "$r = $1|0;" jsvalToWord :: JSVal -> Word#
foreign import javascript unsafe "$r = $1&0xff;" jsvalToWord8 :: JSVal -> Word#
foreign import javascript unsafe "$r = $1&0xffff;" jsvalToWord16 :: JSVal -> Word#
foreign import javascript unsafe "$r = $1|0;" jsvalToInt :: JSVal -> Int#
foreign import javascript unsafe "$r = $1<<24>>24;" jsvalToInt8 :: JSVal -> Int#
foreign import javascript unsafe "$r = $1<<16>>16;" jsvalToInt16 :: JSVal -> Int#
foreign import javascript unsafe "$r = +$1;" jsvalToFloat :: JSVal -> Float#
foreign import javascript unsafe "$r = +$1;" jsvalToDouble :: JSVal -> Double#
foreign import javascript unsafe "$r = $1&0x7fffffff;" jsvalToChar :: JSVal -> Char#
foreign import javascript unsafe "$r = $1;" wordToJSVal :: Word# -> JSVal
foreign import javascript unsafe "$r = $1;" intToJSVal :: Int# -> JSVal
foreign import javascript unsafe "$r = $1;" doubleToJSVal :: Double# -> JSVal
foreign import javascript unsafe "$r = $1;" floatToJSVal :: Float# -> JSVal
foreign import javascript unsafe "$r = $1;" charToJSVal :: Char# -> JSVal