{-# LANGUAGE OverloadedStrings #-}
module JavaScript.Array.Internal
    ( SomeJSArray(..)
    , JSArray
    , MutableJSArray
    , STJSArray
    , create
    , fromList
    , fromListIO
    , toList
    , toListIO
    , index
    , read
    , push
    ) where

import Prelude hiding(read)
import Control.Monad (void)
import GHCJS.Types (JSVal)
import Data.JSString.Internal.Type (JSString(..))
import Language.Javascript.JSaddle.Types (JSM, SomeJSArray(..), JSArray, MutableJSArray, STJSArray, Object(..), GHCJSPure(..))
import Language.Javascript.JSaddle.Native.Internal
       (newArray, getPropertyByName, getPropertyAtIndex, callAsFunction, valueToNumber)

create :: JSM MutableJSArray
create :: JSM MutableJSArray
create = JSVal -> MutableJSArray
forall s (m :: MutabilityType s). JSVal -> SomeJSArray m
SomeJSArray (JSVal -> MutableJSArray) -> JSM JSVal -> JSM MutableJSArray
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JSVal] -> JSM JSVal
newArray []
{-# INLINE create #-}

fromList :: [JSVal] -> GHCJSPure (SomeJSArray m)
fromList :: [JSVal] -> GHCJSPure (SomeJSArray m)
fromList = JSM (SomeJSArray m) -> GHCJSPure (SomeJSArray m)
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM (SomeJSArray m) -> GHCJSPure (SomeJSArray m))
-> ([JSVal] -> JSM (SomeJSArray m))
-> [JSVal]
-> GHCJSPure (SomeJSArray m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSVal] -> JSM (SomeJSArray m)
forall (m :: MutabilityType *). [JSVal] -> JSM (SomeJSArray m)
fromListIO
{-# INLINE fromList #-}

fromListIO :: [JSVal] -> JSM (SomeJSArray m)
fromListIO :: [JSVal] -> JSM (SomeJSArray m)
fromListIO [JSVal]
xs = JSVal -> SomeJSArray m
forall s (m :: MutabilityType s). JSVal -> SomeJSArray m
SomeJSArray (JSVal -> SomeJSArray m) -> JSM JSVal -> JSM (SomeJSArray m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JSVal] -> JSM JSVal
newArray [JSVal]
xs
{-# INLINE fromListIO #-}

toList :: SomeJSArray m -> GHCJSPure [JSVal]
toList :: SomeJSArray m -> GHCJSPure [JSVal]
toList = JSM [JSVal] -> GHCJSPure [JSVal]
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM [JSVal] -> GHCJSPure [JSVal])
-> (SomeJSArray m -> JSM [JSVal])
-> SomeJSArray m
-> GHCJSPure [JSVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeJSArray m -> JSM [JSVal]
forall (m :: MutabilityType *). SomeJSArray m -> JSM [JSVal]
toListIO
{-# INLINE toList #-}

toListIO :: SomeJSArray m -> JSM [JSVal]
toListIO :: SomeJSArray m -> JSM [JSVal]
toListIO (SomeJSArray JSVal
x) = do
    Double
len <- JSString -> Object -> JSM JSVal
getPropertyByName (Text -> JSString
JSString Text
"length") (JSVal -> Object
Object JSVal
x) JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM Double
valueToNumber
    (Int -> JSM JSVal) -> [Int] -> JSM [JSVal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Object -> JSM JSVal
`getPropertyAtIndex` JSVal -> Object
Object JSVal
x) [Int
0..Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
{-# INLINE toListIO #-}

index :: Int -> SomeJSArray m -> GHCJSPure JSVal
index :: Int -> SomeJSArray m -> GHCJSPure JSVal
index Int
n = JSM JSVal -> GHCJSPure JSVal
forall a. JSM a -> GHCJSPure a
GHCJSPure (JSM JSVal -> GHCJSPure JSVal)
-> (SomeJSArray m -> JSM JSVal) -> SomeJSArray m -> GHCJSPure JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SomeJSArray m -> JSM JSVal
forall (m :: MutabilityType *). Int -> SomeJSArray m -> JSM JSVal
read Int
n
{-# INLINE index #-}

read :: Int -> SomeJSArray m -> JSM JSVal
read :: Int -> SomeJSArray m -> JSM JSVal
read Int
n (SomeJSArray JSVal
x) = Int -> Object -> JSM JSVal
getPropertyAtIndex Int
n (Object -> JSM JSVal) -> Object -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ JSVal -> Object
Object JSVal
x
{-# INLINE read #-}

push :: JSVal -> MutableJSArray -> JSM ()
push :: JSVal -> MutableJSArray -> JSM ()
push JSVal
e (SomeJSArray JSVal
x) = JSM () -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
    JSVal
f <- JSString -> Object -> JSM JSVal
getPropertyByName (Text -> JSString
JSString Text
"push") (JSVal -> Object
Object JSVal
x)
    JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ Object -> Object -> [JSVal] -> JSM JSVal
callAsFunction (JSVal -> Object
Object JSVal
f) (JSVal -> Object
Object JSVal
x) [JSVal
e]
{-# INLINE push #-}