module GHCJS.Buffer
( Buffer
, MutableBuffer
, create
, createFromArrayBuffer
, thaw, freeze, clone
, byteLength
, getArrayBuffer
, getUint8Array
, getUint16Array
, getInt32Array
, getDataView
, getFloat32Array
, getFloat64Array
, toByteString, fromByteString
) where
import GHCJS.Buffer.Types
import Control.Lens.Operators ((^.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64 (encode, decode)
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import qualified JavaScript.TypedArray.Internal.Types as I
import JavaScript.TypedArray.ArrayBuffer.Internal (SomeArrayBuffer(..))
import JavaScript.TypedArray.DataView.Internal (SomeDataView(..))
import GHCJS.Marshal (FromJSVal(..))
import Language.Javascript.JSaddle.Types (JSM, GHCJSPure(..), ghcjsPure)
import Language.Javascript.JSaddle.Object (js, js2, jsg1, jsg3)
create :: Int -> JSM MutableBuffer
create :: Int -> JSM MutableBuffer
create Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = JSVal -> MutableBuffer
forall s (a :: MutabilityType s). JSVal -> SomeBuffer a
SomeBuffer (JSVal -> MutableBuffer) -> JSM JSVal -> JSM MutableBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Int -> JSM JSVal
forall name a0.
(ToJSString name, ToJSVal a0) =>
name -> a0 -> JSM JSVal
jsg1 String
"h$newByteArray" Int
n
| Bool
otherwise = String -> JSM MutableBuffer
forall a. HasCallStack => String -> a
error String
"create: negative size"
{-# INLINE create #-}
createFromArrayBuffer :: SomeArrayBuffer any -> GHCJSPure (SomeBuffer any)
createFromArrayBuffer :: forall (any :: MutabilityType (*)).
SomeArrayBuffer any -> GHCJSPure (SomeBuffer any)
createFromArrayBuffer (SomeArrayBuffer JSVal
buf) = JSM (SomeBuffer any) -> GHCJSPure (SomeBuffer any)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (SomeBuffer any) -> GHCJSPure (SomeBuffer any))
-> JSM (SomeBuffer any) -> GHCJSPure (SomeBuffer any)
forall a b. (a -> b) -> a -> b
$ JSVal -> SomeBuffer any
forall s (a :: MutabilityType s). JSVal -> SomeBuffer a
SomeBuffer (JSVal -> SomeBuffer any) -> JSM JSVal -> JSM (SomeBuffer any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> JSVal -> JSM JSVal
forall name a0.
(ToJSString name, ToJSVal a0) =>
name -> a0 -> JSM JSVal
jsg1 String
"h$wrapBuffer" JSVal
buf
{-# INLINE createFromArrayBuffer #-}
getArrayBuffer :: SomeBuffer any -> GHCJSPure (SomeArrayBuffer any)
getArrayBuffer :: forall (any :: MutabilityType (*)).
SomeBuffer any -> GHCJSPure (SomeArrayBuffer any)
getArrayBuffer (SomeBuffer JSVal
buf) = JSM (SomeArrayBuffer any) -> GHCJSPure (SomeArrayBuffer any)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (SomeArrayBuffer any) -> GHCJSPure (SomeArrayBuffer any))
-> JSM (SomeArrayBuffer any) -> GHCJSPure (SomeArrayBuffer any)
forall a b. (a -> b) -> a -> b
$ JSVal -> SomeArrayBuffer any
forall s (a :: MutabilityType s). JSVal -> SomeArrayBuffer a
SomeArrayBuffer (JSVal -> SomeArrayBuffer any)
-> JSM JSVal -> JSM (SomeArrayBuffer any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"buf"
{-# INLINE getArrayBuffer #-}
getInt32Array :: SomeBuffer any -> GHCJSPure (I.SomeInt32Array any)
getInt32Array :: forall (any :: MutabilityType (*)).
SomeBuffer any -> GHCJSPure (SomeInt32Array any)
getInt32Array (SomeBuffer JSVal
buf) = JSM (SomeInt32Array any) -> GHCJSPure (SomeInt32Array any)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (SomeInt32Array any) -> GHCJSPure (SomeInt32Array any))
-> JSM (SomeInt32Array any) -> GHCJSPure (SomeInt32Array any)
forall a b. (a -> b) -> a -> b
$ JSVal -> SomeInt32Array any
forall s (e :: TypedArrayElem) (m :: MutabilityType s).
JSVal -> SomeTypedArray e m
I.SomeTypedArray (JSVal -> SomeInt32Array any)
-> JSM JSVal -> JSM (SomeInt32Array any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"i3"
{-# INLINE getInt32Array #-}
getUint8Array :: SomeBuffer any -> GHCJSPure (I.SomeUint8Array any)
getUint8Array :: forall (any :: MutabilityType (*)).
SomeBuffer any -> GHCJSPure (SomeUint8Array any)
getUint8Array (SomeBuffer JSVal
buf) = JSM (SomeUint8Array any) -> GHCJSPure (SomeUint8Array any)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (SomeUint8Array any) -> GHCJSPure (SomeUint8Array any))
-> JSM (SomeUint8Array any) -> GHCJSPure (SomeUint8Array any)
forall a b. (a -> b) -> a -> b
$ JSVal -> SomeUint8Array any
forall s (e :: TypedArrayElem) (m :: MutabilityType s).
JSVal -> SomeTypedArray e m
I.SomeTypedArray (JSVal -> SomeUint8Array any)
-> JSM JSVal -> JSM (SomeUint8Array any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"u8"
{-# INLINE getUint8Array #-}
getUint16Array :: SomeBuffer any -> GHCJSPure (I.SomeUint16Array any)
getUint16Array :: forall (any :: MutabilityType (*)).
SomeBuffer any -> GHCJSPure (SomeUint16Array any)
getUint16Array (SomeBuffer JSVal
buf) = JSM (SomeUint16Array any) -> GHCJSPure (SomeUint16Array any)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (SomeUint16Array any) -> GHCJSPure (SomeUint16Array any))
-> JSM (SomeUint16Array any) -> GHCJSPure (SomeUint16Array any)
forall a b. (a -> b) -> a -> b
$ JSVal -> SomeUint16Array any
forall s (e :: TypedArrayElem) (m :: MutabilityType s).
JSVal -> SomeTypedArray e m
I.SomeTypedArray (JSVal -> SomeUint16Array any)
-> JSM JSVal -> JSM (SomeUint16Array any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"u1"
{-# INLINE getUint16Array #-}
getFloat32Array :: SomeBuffer any -> GHCJSPure (I.SomeFloat32Array any)
getFloat32Array :: forall (any :: MutabilityType (*)).
SomeBuffer any -> GHCJSPure (SomeFloat32Array any)
getFloat32Array (SomeBuffer JSVal
buf) = JSM (SomeFloat32Array any) -> GHCJSPure (SomeFloat32Array any)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (SomeFloat32Array any) -> GHCJSPure (SomeFloat32Array any))
-> JSM (SomeFloat32Array any) -> GHCJSPure (SomeFloat32Array any)
forall a b. (a -> b) -> a -> b
$ JSVal -> SomeFloat32Array any
forall s (e :: TypedArrayElem) (m :: MutabilityType s).
JSVal -> SomeTypedArray e m
I.SomeTypedArray (JSVal -> SomeFloat32Array any)
-> JSM JSVal -> JSM (SomeFloat32Array any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"f3"
{-# INLINE getFloat32Array #-}
getFloat64Array :: SomeBuffer any -> GHCJSPure (I.SomeFloat64Array any)
getFloat64Array :: forall (any :: MutabilityType (*)).
SomeBuffer any -> GHCJSPure (SomeFloat64Array any)
getFloat64Array (SomeBuffer JSVal
buf) = JSM (SomeFloat64Array any) -> GHCJSPure (SomeFloat64Array any)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (SomeFloat64Array any) -> GHCJSPure (SomeFloat64Array any))
-> JSM (SomeFloat64Array any) -> GHCJSPure (SomeFloat64Array any)
forall a b. (a -> b) -> a -> b
$ JSVal -> SomeFloat64Array any
forall s (e :: TypedArrayElem) (m :: MutabilityType s).
JSVal -> SomeTypedArray e m
I.SomeTypedArray (JSVal -> SomeFloat64Array any)
-> JSM JSVal -> JSM (SomeFloat64Array any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"f6"
{-# INLINE getFloat64Array #-}
getDataView :: SomeBuffer any -> GHCJSPure (SomeDataView any)
getDataView :: forall (any :: MutabilityType (*)).
SomeBuffer any -> GHCJSPure (SomeDataView any)
getDataView (SomeBuffer JSVal
buf) = JSM (SomeDataView any) -> GHCJSPure (SomeDataView any)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (SomeDataView any) -> GHCJSPure (SomeDataView any))
-> JSM (SomeDataView any) -> GHCJSPure (SomeDataView any)
forall a b. (a -> b) -> a -> b
$ JSVal -> SomeDataView any
forall s (a :: MutabilityType s). JSVal -> SomeDataView a
SomeDataView (JSVal -> SomeDataView any) -> JSM JSVal -> JSM (SomeDataView any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"dv"
{-# INLINE getDataView #-}
freeze :: MutableBuffer -> JSM Buffer
freeze :: MutableBuffer -> JSM Buffer
freeze = MutableBuffer -> JSM Buffer
forall (any1 :: MutabilityType (*)) (any2 :: MutabilityType (*)).
SomeBuffer any1 -> JSM (SomeBuffer any2)
js_clone
{-# INLINE freeze #-}
thaw :: Buffer -> JSM MutableBuffer
thaw :: Buffer -> JSM MutableBuffer
thaw = Buffer -> JSM MutableBuffer
forall (any1 :: MutabilityType (*)) (any2 :: MutabilityType (*)).
SomeBuffer any1 -> JSM (SomeBuffer any2)
js_clone
{-# INLINE thaw #-}
clone :: MutableBuffer -> JSM (SomeBuffer any2)
clone :: forall (any2 :: MutabilityType (*)).
MutableBuffer -> JSM (SomeBuffer any2)
clone = MutableBuffer -> JSM (SomeBuffer any2)
forall (any1 :: MutabilityType (*)) (any2 :: MutabilityType (*)).
SomeBuffer any1 -> JSM (SomeBuffer any2)
js_clone
{-# INLINE clone #-}
fromByteString :: ByteString -> GHCJSPure (Buffer, Int, Int)
fromByteString :: ByteString -> GHCJSPure (Buffer, Int, Int)
fromByteString ByteString
bs = JSM (Buffer, Int, Int) -> GHCJSPure (Buffer, Int, Int)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (Buffer, Int, Int) -> GHCJSPure (Buffer, Int, Int))
-> JSM (Buffer, Int, Int) -> GHCJSPure (Buffer, Int, Int)
forall a b. (a -> b) -> a -> b
$ do
Buffer
buffer <- JSVal -> Buffer
forall s (a :: MutabilityType s). JSVal -> SomeBuffer a
SomeBuffer (JSVal -> Buffer) -> JSM JSVal -> JSM Buffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text -> JSM JSVal
forall name a0.
(ToJSString name, ToJSVal a0) =>
name -> a0 -> JSM JSVal
jsg1 String
"h$newByteArrayFromBase64String" (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
bs)
(Buffer, Int, Int) -> JSM (Buffer, Int, Int)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer
buffer, Int
0, ByteString -> Int
BS.length ByteString
bs)
{-# INLINE fromByteString #-}
toByteString :: Int -> Maybe Int -> Buffer -> GHCJSPure ByteString
toByteString :: Int -> Maybe Int -> Buffer -> GHCJSPure ByteString
toByteString Int
off Maybe Int
mbLen Buffer
buf = JSM ByteString -> GHCJSPure ByteString
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM ByteString -> GHCJSPure ByteString)
-> JSM ByteString -> GHCJSPure ByteString
forall a b. (a -> b) -> a -> b
$ do
Int
bufLen <- GHCJSPure Int -> JSM Int
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure Int -> JSM Int) -> GHCJSPure Int -> JSM Int
forall a b. (a -> b) -> a -> b
$ Buffer -> GHCJSPure Int
forall (any :: MutabilityType (*)). SomeBuffer any -> GHCJSPure Int
byteLength Buffer
buf
case Maybe Int
mbLen of
Maybe Int
_ | Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> String -> JSM ByteString
forall a. HasCallStack => String -> a
error String
"toByteString: negative offset"
| Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bufLen -> String -> JSM ByteString
forall a. HasCallStack => String -> a
error String
"toByteString: offset past end of buffer"
Just Int
len | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> String -> JSM ByteString
forall a. HasCallStack => String -> a
error String
"toByteString: negative length"
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bufLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off -> String -> JSM ByteString
forall a. HasCallStack => String -> a
error String
"toByteString: length past end of buffer"
| Bool
otherwise -> GHCJSPure ByteString -> JSM ByteString
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure ByteString -> JSM ByteString)
-> GHCJSPure ByteString -> JSM ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Buffer -> GHCJSPure ByteString
unsafeToByteString Int
off Int
len Buffer
buf
Maybe Int
Nothing -> GHCJSPure ByteString -> JSM ByteString
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure ByteString -> JSM ByteString)
-> GHCJSPure ByteString -> JSM ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Buffer -> GHCJSPure ByteString
unsafeToByteString Int
off (Int
bufLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off) Buffer
buf
unsafeToByteString :: Int -> Int -> Buffer -> GHCJSPure ByteString
unsafeToByteString :: Int -> Int -> Buffer -> GHCJSPure ByteString
unsafeToByteString Int
off Int
len (SomeBuffer JSVal
buf) = JSM ByteString -> GHCJSPure ByteString
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM ByteString -> GHCJSPure ByteString)
-> JSM ByteString -> GHCJSPure ByteString
forall a b. (a -> b) -> a -> b
$ do
Text
b64 <- String -> Int -> Int -> JSVal -> JSM JSVal
forall name a0 a1 a2.
(ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2) =>
name -> a0 -> a1 -> a2 -> JSM JSVal
jsg3 String
"h$byteArrayToBase64String" Int
off Int
len JSVal
buf JSM JSVal -> (JSVal -> JSM Text) -> JSM Text
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM Text
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked
ByteString -> JSM ByteString
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> JSM ByteString) -> ByteString -> JSM ByteString
forall a b. (a -> b) -> a -> b
$ case ByteString -> Either String ByteString
B64.decode (Text -> ByteString
encodeUtf8 Text
b64) of
Left String
err -> String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"unsafeToByteString base 64 decode error :" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
Right ByteString
bs -> ByteString
bs
byteLength :: SomeBuffer any -> GHCJSPure Int
byteLength :: forall (any :: MutabilityType (*)). SomeBuffer any -> GHCJSPure Int
byteLength (SomeBuffer JSVal
buf) = JSM Int -> GHCJSPure Int
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM Int -> GHCJSPure Int) -> JSM Int -> GHCJSPure Int
forall a b. (a -> b) -> a -> b
$ JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"len" JSM JSVal -> (JSVal -> JSM Int) -> JSM Int
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked
{-# INLINE byteLength #-}
js_clone :: SomeBuffer any1 -> JSM (SomeBuffer any2)
js_clone :: forall (any1 :: MutabilityType (*)) (any2 :: MutabilityType (*)).
SomeBuffer any1 -> JSM (SomeBuffer any2)
js_clone (SomeBuffer JSVal
buf) = JSVal -> SomeBuffer any2
forall s (a :: MutabilityType s). JSVal -> SomeBuffer a
SomeBuffer (JSVal -> SomeBuffer any2) -> JSM JSVal -> JSM (SomeBuffer any2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> JSM JSVal -> JSM JSVal
forall name a0.
(ToJSString name, ToJSVal a0) =>
name -> a0 -> JSM JSVal
jsg1 String
"h$wrapBuffer" (JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"buf" JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> JSM JSVal -> JSM JSVal -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
js2 String
"slice" (JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"u8" JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter (JSM JSVal) (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"byteOffset") (JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"len"))