content: {-# 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 ab = liftJSM $ JS.unsafeFreeze ab >>=
      ghcjsPure . JS.createFromArrayBuffer >>= ghcjsPure . JS.toByteString 0 Nothing
  
  {-# INLINABLE bsToArrayBuffer #-}
  bsToArrayBuffer :: MonadJSM m => ByteString -> m ArrayBuffer
  bsToArrayBuffer bs = liftJSM $ do
    (b, off, len) <- ghcjsPure $ JS.fromByteString bs
    ArrayBuffer <$> if BS.length bs == 0 --TODO: remove this logic when https://github.com/ghcjs/ghcjs-base/issues/49 is fixed
                    then JS.create 0 >>= ghcjsPure . JS.getArrayBuffer >>= ghcjsPure . jsval
                    else do
                      ref <- ghcjsPure (JS.getArrayBuffer b) >>= ghcjsPure . jsval
                      js_dataView off len 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 = decode . LBS.fromStrict . encodeUtf8 . textFromJSString
  #endif
  
  js_jsonParse :: JSString -> JSM JSVal
  js_jsonParse a = jsg "JSON" ^. js1 "parse" a
  