{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Foreign.JavaScript.Utils
  ( bsFromMutableArrayBuffer
  , bsToArrayBuffer
  , jsonDecode
  , js_jsonParse
  ) where

import Control.Lens
import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Foreign.JavaScript.Internal.Utils (js_dataView)
import qualified GHCJS.Buffer as JS
import GHCJS.DOM.Types (ArrayBuffer (..))
import GHCJS.Marshal ()
import Language.Javascript.JSaddle (jsg, js1)
import qualified JavaScript.TypedArray.ArrayBuffer as JS
import Language.Javascript.JSaddle.Types (JSString, JSM, JSVal, MonadJSM, ghcjsPure, jsval, liftJSM)
#ifdef ghcjs_HOST_OS
import Control.Exception (SomeException)
import Language.Javascript.JSaddle (fromJSVal, catch)
import System.IO.Unsafe
#else
import qualified Data.ByteString.Lazy as LBS
import Data.Text.Encoding
import Language.Javascript.JSaddle (textFromJSString)
#endif

{-# INLINABLE bsFromMutableArrayBuffer #-}
bsFromMutableArrayBuffer :: MonadJSM m => JS.MutableArrayBuffer -> m ByteString
bsFromMutableArrayBuffer :: MutableArrayBuffer -> m ByteString
bsFromMutableArrayBuffer ab :: MutableArrayBuffer
ab = JSM ByteString -> m ByteString
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM ByteString -> m ByteString) -> JSM ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ MutableArrayBuffer -> JSM ArrayBuffer
JS.unsafeFreeze MutableArrayBuffer
ab JSM ArrayBuffer
-> (ArrayBuffer -> JSM (SomeBuffer Immutable))
-> JSM (SomeBuffer Immutable)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    GHCJSPure (SomeBuffer Immutable) -> JSM (SomeBuffer Immutable)
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure (SomeBuffer Immutable) -> JSM (SomeBuffer Immutable))
-> (ArrayBuffer -> GHCJSPure (SomeBuffer Immutable))
-> ArrayBuffer
-> JSM (SomeBuffer Immutable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayBuffer -> GHCJSPure (SomeBuffer Immutable)
forall (any :: MutabilityType *).
SomeArrayBuffer any -> GHCJSPure (SomeBuffer any)
JS.createFromArrayBuffer JSM (SomeBuffer Immutable)
-> (SomeBuffer Immutable -> JSM ByteString) -> JSM ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GHCJSPure ByteString -> JSM ByteString
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure ByteString -> JSM ByteString)
-> (SomeBuffer Immutable -> GHCJSPure ByteString)
-> SomeBuffer Immutable
-> JSM ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> SomeBuffer Immutable -> GHCJSPure ByteString
JS.toByteString 0 Maybe Int
forall a. Maybe a
Nothing

{-# INLINABLE bsToArrayBuffer #-}
bsToArrayBuffer :: MonadJSM m => ByteString -> m ArrayBuffer
bsToArrayBuffer :: ByteString -> m ArrayBuffer
bsToArrayBuffer bs :: ByteString
bs = JSM ArrayBuffer -> m ArrayBuffer
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM ArrayBuffer -> m ArrayBuffer)
-> JSM ArrayBuffer -> m ArrayBuffer
forall a b. (a -> b) -> a -> b
$ do
  (b :: SomeBuffer Immutable
b, off :: Int
off, len :: Int
len) <- GHCJSPure (SomeBuffer Immutable, Int, Int)
-> JSM (SomeBuffer Immutable, Int, Int)
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure (SomeBuffer Immutable, Int, Int)
 -> JSM (SomeBuffer Immutable, Int, Int))
-> GHCJSPure (SomeBuffer Immutable, Int, Int)
-> JSM (SomeBuffer Immutable, Int, Int)
forall a b. (a -> b) -> a -> b
$ ByteString -> GHCJSPure (SomeBuffer Immutable, Int, Int)
JS.fromByteString ByteString
bs
  JSVal -> ArrayBuffer
ArrayBuffer (JSVal -> ArrayBuffer) -> JSM JSVal -> JSM ArrayBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 --TODO: remove this logic when https://github.com/ghcjs/ghcjs-base/issues/49 is fixed
                  then Int -> JSM MutableBuffer
JS.create 0 JSM MutableBuffer
-> (MutableBuffer -> JSM MutableArrayBuffer)
-> JSM MutableArrayBuffer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GHCJSPure MutableArrayBuffer -> JSM MutableArrayBuffer
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure MutableArrayBuffer -> JSM MutableArrayBuffer)
-> (MutableBuffer -> GHCJSPure MutableArrayBuffer)
-> MutableBuffer
-> JSM MutableArrayBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableBuffer -> GHCJSPure MutableArrayBuffer
forall (any :: MutabilityType *).
SomeBuffer any -> GHCJSPure (SomeArrayBuffer any)
JS.getArrayBuffer JSM MutableArrayBuffer
-> (MutableArrayBuffer -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GHCJSPure JSVal -> JSM JSVal
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure JSVal -> JSM JSVal)
-> (MutableArrayBuffer -> GHCJSPure JSVal)
-> MutableArrayBuffer
-> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableArrayBuffer -> GHCJSPure JSVal
forall a. IsJSVal a => a -> GHCJSPure JSVal
jsval
                  else do
                    JSVal
ref <- GHCJSPure ArrayBuffer -> JSM ArrayBuffer
forall a. GHCJSPure a -> JSM a
ghcjsPure (SomeBuffer Immutable -> GHCJSPure ArrayBuffer
forall (any :: MutabilityType *).
SomeBuffer any -> GHCJSPure (SomeArrayBuffer any)
JS.getArrayBuffer SomeBuffer Immutable
b) JSM ArrayBuffer -> (ArrayBuffer -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GHCJSPure JSVal -> JSM JSVal
forall a. GHCJSPure a -> JSM a
ghcjsPure (GHCJSPure JSVal -> JSM JSVal)
-> (ArrayBuffer -> GHCJSPure JSVal) -> ArrayBuffer -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayBuffer -> GHCJSPure JSVal
forall a. IsJSVal a => a -> GHCJSPure JSVal
jsval
                    Int -> Int -> JSVal -> JSM JSVal
js_dataView Int
off Int
len JSVal
ref

jsonDecode :: FromJSON a => JSString -> Maybe a
#ifdef ghcjs_HOST_OS
jsonDecode t = do
  result <- unsafePerformIO $ (fromJSVal =<< js_jsonParse t) `catch` (\(_ :: SomeException) -> pure Nothing)
  case fromJSON result of
    Success a -> Just a
    Error _ -> Nothing
#else
jsonDecode :: JSString -> Maybe a
jsonDecode = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe a)
-> (JSString -> ByteString) -> JSString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> (JSString -> ByteString) -> JSString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (JSString -> Text) -> JSString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSString -> Text
textFromJSString
#endif

js_jsonParse :: JSString -> JSM JSVal
js_jsonParse :: JSString -> JSM JSVal
js_jsonParse a :: JSString
a = [Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg "JSON" JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> JSString -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
js1 "parse" JSString
a