module GHCJS.Buffer
    ( Buffer
    , MutableBuffer
    , create
    , createFromArrayBuffer
    , thaw, freeze, clone
      -- * JavaScript properties
    , byteLength
    , getArrayBuffer
    , getUint8Array
    , getUint16Array
    , getInt32Array
    , getDataView
    , getFloat32Array
    , getFloat64Array
      -- * bytestring
    , 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
<$> [Char] -> Int -> JSM JSVal
forall name a0.
(ToJSString name, ToJSVal a0) =>
name -> a0 -> JSM JSVal
jsg1 [Char]
"h$newByteArray" Int
n
         | Bool
otherwise = [Char] -> JSM MutableBuffer
forall a. HasCallStack => [Char] -> a
error [Char]
"create: negative size"
{-# INLINE create #-}

createFromArrayBuffer :: SomeArrayBuffer any -> GHCJSPure (SomeBuffer any)
createFromArrayBuffer :: 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
<$> [Char] -> JSVal -> JSM JSVal
forall name a0.
(ToJSString name, ToJSVal a0) =>
name -> a0 -> JSM JSVal
jsg1 [Char]
"h$wrapBuffer" JSVal
buf
{-# INLINE createFromArrayBuffer #-}

getArrayBuffer :: SomeBuffer any -> GHCJSPure (SomeArrayBuffer any)
getArrayBuffer :: 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
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"buf"
{-# INLINE getArrayBuffer #-}

getInt32Array :: SomeBuffer any -> GHCJSPure (I.SomeInt32Array any)
getInt32Array :: 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
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"i3"
{-# INLINE getInt32Array #-}

getUint8Array :: SomeBuffer any -> GHCJSPure (I.SomeUint8Array any)
getUint8Array :: 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
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"u8"
{-# INLINE getUint8Array #-}

getUint16Array :: SomeBuffer any -> GHCJSPure (I.SomeUint16Array any)
getUint16Array :: 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
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"u1"
{-# INLINE getUint16Array #-}

getFloat32Array :: SomeBuffer any -> GHCJSPure (I.SomeFloat32Array any)
getFloat32Array :: 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
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"f3"
{-# INLINE getFloat32Array #-}

getFloat64Array :: SomeBuffer any -> GHCJSPure (I.SomeFloat64Array any)
getFloat64Array :: 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
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"f6"
{-# INLINE getFloat64Array #-}

getDataView :: SomeBuffer any -> GHCJSPure (SomeDataView any)
getDataView :: 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
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"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 :: 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
<$> [Char] -> Text -> JSM JSVal
forall name a0.
(ToJSString name, ToJSVal a0) =>
name -> a0 -> JSM JSVal
jsg1 [Char]
"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 (m :: * -> *) a. Monad m => a -> m a
return (Buffer
buffer, Int
0, ByteString -> Int
BS.length ByteString
bs)
{-# INLINE fromByteString #-}

-- | Wrap a 'Buffer' into a 'ByteString' using the given offset
-- and length.
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            -> [Char] -> JSM ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"toByteString: negative offset"
             | Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bufLen       -> [Char] -> JSM ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"toByteString: offset past end of buffer"
    Just Int
len | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0            -> [Char] -> JSM ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"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 -> [Char] -> JSM ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"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 <- [Char] -> 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 [Char]
"h$byteArrayToBase64String" Int
off Int
len JSVal
buf JSM JSVal -> (JSVal -> JSM Text) -> JSM Text
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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> JSM ByteString) -> ByteString -> JSM ByteString
forall a b. (a -> b) -> a -> b
$ case ByteString -> Either [Char] ByteString
B64.decode (Text -> ByteString
encodeUtf8 Text
b64) of
            Left [Char]
err -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"unsafeToByteString base 64 decode error :" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err
            Right ByteString
bs -> ByteString
bs

byteLength :: SomeBuffer any -> GHCJSPure Int
byteLength :: 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
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"len" JSM JSVal -> (JSVal -> JSM Int) -> JSM Int
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 :: 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
<$> [Char] -> JSM JSVal -> JSM JSVal
forall name a0.
(ToJSString name, ToJSVal a0) =>
name -> a0 -> JSM JSVal
jsg1 [Char]
"h$wrapBuffer" (JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"buf" JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> JSM JSVal -> JSM JSVal -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
js2 [Char]
"slice" (JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"u8" JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter (JSM JSVal) (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"byteOffset") (JSVal
buf JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter JSVal (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"len"))