module JavaScript.TypedArray.DataView.ST
( STDataView
, dataView
, freeze, unsafeFreeze
, thaw, unsafeThaw
, readInt8, unsafeReadInt8
, readInt16LE, readInt16BE, unsafeReadInt16LE, unsafeReadInt16BE
, readInt32LE, readInt32BE, unsafeReadInt32LE, unsafeReadInt32BE
, readUint8, unsafeReadUint8
, readUint16LE, readUint16BE, unsafeReadUint16LE, unsafeReadUint16BE
, readUint32LE, readUint32BE, unsafeReadUint32LE, unsafeReadUint32BE
, readFloat32LE, readFloat32BE, unsafeReadFloat32LE, unsafeReadFloat32BE
, readFloat64LE, readFloat64BE, unsafeReadFloat64LE, unsafeReadFloat64BE
, writeInt8, unsafeWriteInt8
, writeInt16LE, writeInt16BE, unsafeWriteInt16LE, unsafeWriteInt16BE
, writeInt32LE, writeInt32BE, unsafeWriteInt32LE, unsafeWriteInt32BE
, writeUint8, unsafeWriteUint8
, writeUint16LE, writeUint16BE, unsafeWriteUint16LE, unsafeWriteUint16BE
, writeUint32LE, writeUint32BE, unsafeWriteUint32LE, unsafeWriteUint32BE
, writeFloat32LE, writeFloat32BE, unsafeWriteFloat32LE, unsafeWriteFloat32BE
, writeFloat64LE, writeFloat64BE, unsafeWriteFloat64LE, unsafeWriteFloat64BE
) where
import Data.Int
import Data.Word
import GHC.ST
import GHCJS.Prim
import JavaScript.TypedArray.ArrayBuffer.ST
import JavaScript.TypedArray.ArrayBuffer.Internal as AI
import JavaScript.TypedArray.DataView.Internal ( SomeDataView(..), STDataView )
import qualified JavaScript.TypedArray.DataView.Internal as I
dataView :: STArrayBuffer s -> STDataView s
dataView (SomeArrayBuffer b) = SomeDataView (I.js_dataView1 b)
{-# INLINE dataView #-}
dataView' :: Int
-> Maybe Int
-> STArrayBuffer s
-> STDataView s
dataView' byteOffset mbyteLength (SomeArrayBuffer b) =
case mbyteLength of
Nothing -> I.js_dataView2 byteOffset b
Just byteLength -> I.js_dataView byteOffset byteLength b
{-# INLINE dataView' #-}
unsafeDataView' :: Int
-> Maybe Int
-> STArrayBuffer s
-> STDataView s
unsafeDataView' byteOffset mbyteLength (SomeArrayBuffer b) =
case mbyteLength of
Nothing -> I.js_dataView2 byteOffset b
Just byteLength -> I.js_dataView byteOffset byteLength b
{-# INLINE unsafeDataView' #-}
readInt8, unsafeReadInt8 :: Int -> STDataView s -> ST s Int8
readInt8 idx dv = ST (I.js_m_getInt8 idx dv)
unsafeReadInt8 idx dv = ST (I.js_m_unsafeGetInt8 idx dv)
{-# INLINE readInt8 #-}
readUint8, unsafeReadUint8 :: Int -> STDataView s -> ST s Word8
readUint8 idx dv = ST (I.js_m_unsafeGetUint8 idx dv)
unsafeReadUint8 idx dv = ST (I.js_m_unsafeGetUint8 idx dv)
{-# INLINE readUint8 #-}
readInt16LE, readInt16BE, unsafeReadInt16LE, unsafeReadInt16BE
:: Int -> STDataView s -> ST s Int16
readInt16LE idx dv = ST (I.js_m_getInt16LE idx dv)
readInt16BE idx dv = ST (I.js_m_getInt16BE idx dv)
unsafeReadInt16LE idx dv = ST (I.js_m_unsafeGetInt16LE idx dv)
unsafeReadInt16BE idx dv = ST (I.js_m_unsafeGetInt16BE idx dv)
{-# INLINE readInt16LE #-}
{-# INLINE readInt16BE #-}
{-# INLINE unsafeReadInt16LE #-}
{-# INLINE unsafeReadInt16BE #-}
readUint16LE, readUint16BE, unsafeReadUint16LE, unsafeReadUint16BE
:: Int -> STDataView s -> ST s Word16
readUint16LE idx dv = ST (I.js_m_getUint16LE idx dv)
readUint16BE idx dv = ST (I.js_m_getUint16BE idx dv)
unsafeReadUint16LE idx dv = ST (I.js_m_unsafeGetUint16LE idx dv)
unsafeReadUint16BE idx dv = ST (I.js_m_unsafeGetUint16BE idx dv)
{-# INLINE readUint16LE #-}
{-# INLINE readUint16BE #-}
{-# INLINE unsafeReadUint16LE #-}
{-# INLINE unsafeReadUint16BE #-}
readInt32LE, readInt32BE, unsafeReadInt32LE, unsafeReadInt32BE
:: Int -> STDataView s -> ST s Int
readInt32LE idx dv = ST (I.js_m_getInt32LE idx dv)
readInt32BE idx dv = ST (I.js_m_getInt32BE idx dv)
unsafeReadInt32LE idx dv = ST (I.js_m_unsafeGetInt32LE idx dv)
unsafeReadInt32BE idx dv = ST (I.js_m_unsafeGetInt32BE idx dv)
{-# INLINE readInt32LE #-}
{-# INLINE readInt32BE #-}
{-# INLINE unsafeReadInt32LE #-}
{-# INLINE unsafeReadInt32BE #-}
readUint32LE, readUint32BE, unsafeReadUint32LE, unsafeReadUint32BE
:: Int -> STDataView s -> ST s Word
readUint32LE idx dv = ST (I.js_m_getUint32LE idx dv)
readUint32BE idx dv = ST (I.js_m_getUint32BE idx dv)
unsafeReadUint32LE idx dv = ST (I.js_m_unsafeGetUint32LE idx dv)
unsafeReadUint32BE idx dv = ST (I.js_m_unsafeGetUint32BE idx dv)
{-# INLINE readUint32LE #-}
{-# INLINE readUint32BE #-}
{-# INLINE unsafeReadUint32LE #-}
{-# INLINE unsafeReadUint32BE #-}
readFloat32LE, readFloat32BE, unsafeReadFloat32LE, unsafeReadFloat32BE
:: Int -> STDataView s -> ST s Double
readFloat32LE idx dv = ST (I.js_m_getFloat32LE idx dv)
readFloat32BE idx dv = ST (I.js_m_getFloat32BE idx dv)
unsafeReadFloat32LE idx dv = ST (I.js_m_unsafeGetFloat32LE idx dv)
unsafeReadFloat32BE idx dv = ST (I.js_m_unsafeGetFloat32BE idx dv)
{-# INLINE readFloat32LE #-}
{-# INLINE readFloat32BE #-}
{-# INLINE unsafeReadFloat32LE #-}
{-# INLINE unsafeReadFloat32BE #-}
readFloat64LE, readFloat64BE, unsafeReadFloat64LE, unsafeReadFloat64BE
:: Int -> STDataView s -> ST s Double
readFloat64LE idx dv = ST (I.js_m_getFloat64LE idx dv)
readFloat64BE idx dv = ST (I.js_m_getFloat64BE idx dv)
unsafeReadFloat64LE idx dv = ST (I.js_m_unsafeGetFloat64LE idx dv)
unsafeReadFloat64BE idx dv = ST (I.js_m_unsafeGetFloat64BE idx dv)
{-# INLINE readFloat64LE #-}
{-# INLINE readFloat64BE #-}
{-# INLINE unsafeReadFloat64LE #-}
{-# INLINE unsafeReadFloat64BE #-}
writeInt8, unsafeWriteInt8 :: Int -> Int8 -> STDataView s -> ST s ()
writeInt8 idx x dv = ST (I.js_setInt8 idx x dv)
unsafeWriteInt8 idx x dv = ST (I.js_unsafeSetInt8 idx x dv)
{-# INLINE writeInt8 #-}
{-# INLINE unsafeWriteInt8 #-}
writeUint8, unsafeWriteUint8 :: Int -> Word8 -> STDataView s -> ST s ()
writeUint8 idx x dv = ST (I.js_setUint8 idx x dv)
unsafeWriteUint8 idx x dv = ST (I.js_unsafeSetUint8 idx x dv)
{-# INLINE writeUint8 #-}
{-# INLINE unsafeWriteUint8 #-}
writeInt16LE, writeInt16BE, unsafeWriteInt16LE, unsafeWriteInt16BE
:: Int -> Int16 -> STDataView s -> ST s ()
writeInt16LE idx x dv = ST (I.js_setInt16LE idx x dv)
writeInt16BE idx x dv = ST (I.js_setInt16BE idx x dv)
unsafeWriteInt16LE idx x dv = ST (I.js_unsafeSetInt16LE idx x dv)
unsafeWriteInt16BE idx x dv = ST (I.js_unsafeSetInt16BE idx x dv)
{-# INLINE writeInt16LE #-}
{-# INLINE writeInt16BE #-}
{-# INLINE unsafeWriteInt16LE #-}
{-# INLINE unsafeWriteInt16BE #-}
writeUint16LE, writeUint16BE, unsafeWriteUint16LE, unsafeWriteUint16BE
:: Int -> Word16 -> STDataView s -> ST s ()
writeUint16LE idx x dv = ST (I.js_setUint16LE idx x dv)
writeUint16BE idx x dv = ST (I.js_setUint16BE idx x dv)
unsafeWriteUint16LE idx x dv = ST (I.js_unsafeSetUint16LE idx x dv)
unsafeWriteUint16BE idx x dv = ST (I.js_unsafeSetUint16BE idx x dv)
{-# INLINE writeUint16LE #-}
{-# INLINE writeUint16BE #-}
{-# INLINE unsafeWriteUint16LE #-}
{-# INLINE unsafeWriteUint16BE #-}
writeInt32LE, writeInt32BE, unsafeWriteInt32LE, unsafeWriteInt32BE
:: Int -> Int -> STDataView s -> ST s ()
writeInt32LE idx x dv = ST (I.js_setInt32LE idx x dv)
writeInt32BE idx x dv = ST (I.js_setInt32BE idx x dv)
unsafeWriteInt32LE idx x dv = ST (I.js_unsafeSetInt32LE idx x dv)
unsafeWriteInt32BE idx x dv = ST (I.js_unsafeSetInt32BE idx x dv)
{-# INLINE writeInt32LE #-}
{-# INLINE writeInt32BE #-}
{-# INLINE unsafeWriteInt32LE #-}
{-# INLINE unsafeWriteInt32BE #-}
writeUint32LE, writeUint32BE, unsafeWriteUint32LE, unsafeWriteUint32BE
:: Int -> Word -> STDataView s -> ST s ()
writeUint32LE idx x dv = ST (I.js_setUint32LE idx x dv)
writeUint32BE idx x dv = ST (I.js_setUint32BE idx x dv)
unsafeWriteUint32LE idx x dv = ST (I.js_unsafeSetUint32LE idx x dv)
unsafeWriteUint32BE idx x dv = ST (I.js_unsafeSetUint32BE idx x dv)
{-# INLINE writeUint32LE #-}
{-# INLINE writeUint32BE #-}
{-# INLINE unsafeWriteUint32LE #-}
{-# INLINE unsafeWriteUint32BE #-}
writeFloat32LE, writeFloat32BE, unsafeWriteFloat32LE, unsafeWriteFloat32BE
:: Int -> Double -> STDataView s -> ST s ()
writeFloat32LE idx x dv = ST (I.js_setFloat32LE idx x dv)
writeFloat32BE idx x dv = ST (I.js_setFloat32BE idx x dv)
unsafeWriteFloat32LE idx x dv = ST (I.js_unsafeSetFloat32LE idx x dv)
unsafeWriteFloat32BE idx x dv = ST (I.js_unsafeSetFloat32BE idx x dv)
{-# INLINE writeFloat32LE #-}
{-# INLINE writeFloat32BE #-}
{-# INLINE unsafeWriteFloat32LE #-}
{-# INLINE unsafeWriteFloat32BE #-}
writeFloat64LE, writeFloat64BE, unsafeWriteFloat64LE, unsafeWriteFloat64BE
:: Int -> Double -> STDataView s -> ST s ()
writeFloat64LE idx x dv = ST (I.js_setFloat64LE idx x dv)
writeFloat64BE idx x dv = ST (I.js_setFloat64BE idx x dv)
unsafeWriteFloat64LE idx x dv = ST (I.js_unsafeSetFloat64LE idx x dv)
unsafeWriteFloat64BE idx x dv = ST (I.js_unsafeSetFloat64BE idx x dv)
{-# INLINE writeFloat64LE #-}
{-# INLINE writeFloat64BE #-}
{-# INLINE unsafeWriteFloat64LE #-}
{-# INLINE unsafeWriteFloat64BE #-}