-----------------------------------------------------------------------------
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Data.Array
-- Copyright   :  (C) 2016-2025 David M. Johnson (@dmjio)
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Mutable 'Array' data structure in 'IO'.
--
-- A JavaScript [Array](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Array). This is a convenience for manipulating JavaScript data structures from Haskell.
--
-- We recommend using this module qualified.
--
-- > import qualified Miso.Data.Array as M
--
-----------------------------------------------------------------------------
module Miso.Data.Array
  ( -- * Type
    Array
    -- * Construction
  , new
  , fromList
    -- * Deconstruction
  , toList
    -- * Operations
  , insert
  , push
  , member
  , size
  , splice
  , singleton
  , pop
  , shift
  , unshift
  , null
  , lookup
  , (!?)
  , reverse
  ) where
-----------------------------------------------------------------------------
import           Control.Monad (void, forM, forM_)
import           Prelude hiding (lookup, null, reverse)
-----------------------------------------------------------------------------
import           Miso.DSL (jsg, JSVal, ToObject, ToJSVal, FromJSVal, (!))
import qualified Miso.DSL as DSL
import           Miso.FFI (callFunction)
import           Miso.String (ms, unpack)
-----------------------------------------------------------------------------
newtype Array value = Array JSVal deriving (JSVal -> IO (Maybe (Array value))
JSVal -> IO (Array value)
(JSVal -> IO (Maybe (Array value)))
-> (JSVal -> IO (Array value)) -> FromJSVal (Array value)
forall value. JSVal -> IO (Maybe (Array value))
forall value. JSVal -> IO (Array value)
forall a. (JSVal -> IO (Maybe a)) -> (JSVal -> IO a) -> FromJSVal a
$cfromJSVal :: forall value. JSVal -> IO (Maybe (Array value))
fromJSVal :: JSVal -> IO (Maybe (Array value))
$cfromJSValUnchecked :: forall value. JSVal -> IO (Array value)
fromJSValUnchecked :: JSVal -> IO (Array value)
FromJSVal, Array value -> IO JSVal
(Array value -> IO JSVal) -> ToJSVal (Array value)
forall value. Array value -> IO JSVal
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: forall value. Array value -> IO JSVal
toJSVal :: Array value -> IO JSVal
ToJSVal, Array value -> IO Object
(Array value -> IO Object) -> ToObject (Array value)
forall value. Array value -> IO Object
forall a. (a -> IO Object) -> ToObject a
$ctoObject :: forall value. Array value -> IO Object
toObject :: Array value -> IO Object
ToObject)
-----------------------------------------------------------------------------
-- | Constructs a new JS [Array](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Array) in t'IO'.
--
new :: IO (Array value)
new :: forall value. IO (Array value)
new = JSVal -> Array value
forall value. JSVal -> Array value
Array (JSVal -> Array value) -> IO JSVal -> IO (Array value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO JSVal -> [JSVal] -> IO JSVal
forall constructor args.
(ToObject constructor, ToArgs args) =>
constructor -> args -> IO JSVal
DSL.new (MisoString -> IO JSVal
jsg MisoString
"Array") ([] :: [JSVal])
-----------------------------------------------------------------------------
-- | Inserts a value into the t'Array' by value.
insert :: ToJSVal value => Int -> value -> Array value -> IO ()
insert :: forall value. ToJSVal value => Int -> value -> Array value -> IO ()
insert Int
key value
value (Array JSVal
m) = do
  _ <- (JSVal -> Object
DSL.Object JSVal
m) Object -> Int -> value -> IO ()
forall o v. (ToObject o, ToJSVal v) => o -> Int -> v -> IO ()
DSL.<## Int
key (value -> IO ()) -> value -> IO ()
forall a b. (a -> b) -> a -> b
$ value
value
  pure ()
-----------------------------------------------------------------------------
-- | Inserts a value into the t'Array' by value.
push :: ToJSVal value => value -> Array value -> IO ()
push :: forall value. ToJSVal value => value -> Array value -> IO ()
push value
value (Array JSVal
m) = do
  _ <- JSVal -> MisoString -> [value] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
m MisoString
"push" [value
value]
  pure ()
-----------------------------------------------------------------------------
-- | Look up a value in the array by key.
lookup :: FromJSVal value => Int -> Array value -> IO (Maybe value)
lookup :: forall value.
FromJSVal value =>
Int -> Array value -> IO (Maybe value)
lookup Int
key Array value
m = JSVal -> IO (Maybe value)
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO (Maybe value)) -> IO JSVal -> IO (Maybe value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Array value
m Array value -> Int -> IO JSVal
forall object. ToObject object => object -> Int -> IO JSVal
DSL.!! Int
key
-----------------------------------------------------------------------------
-- | Look up a value in the array by key.
(!?) :: FromJSVal value => Int -> Array value -> IO value
!? :: forall value. FromJSVal value => Int -> Array value -> IO value
(!?) Int
key Array value
m =
  Int -> Array value -> IO (Maybe value)
forall value.
FromJSVal value =>
Int -> Array value -> IO (Maybe value)
lookup Int
key Array value
m IO (Maybe value) -> (Maybe value -> IO value) -> IO value
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe value
Nothing ->
      String -> IO value
forall a. HasCallStack => String -> a
error (String
"(!?) index out of bounds: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> MisoString -> String
unpack (Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Int
key))
    Just value
value ->
      value -> IO value
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure value
value
-----------------------------------------------------------------------------
-- | Return the size of t'Array'.
size :: Array value -> IO Int
size :: forall value. Array value -> IO Int
size (Array JSVal
m) = JSVal -> IO Int
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO Int) -> IO JSVal -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
m JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"length"
-----------------------------------------------------------------------------
-- | Return the null of t'Array'.
null :: Array value -> IO Bool
null :: forall value. Array value -> IO Bool
null Array value
m = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array value -> IO Int
forall value. Array value -> IO Int
size Array value
m
-----------------------------------------------------------------------------
-- | Checks existence of 'value' in t'Array', returns t'Bool.
member :: ToJSVal value => value -> Array value -> IO Bool
member :: forall value. ToJSVal value => value -> Array value -> IO Bool
member value
value (Array JSVal
m) = JSVal -> IO Bool
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO Bool) -> IO JSVal -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> MisoString -> JSVal -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
m MisoString
"includes" (JSVal -> IO JSVal) -> IO JSVal -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< value -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
DSL.toJSVal value
value
-----------------------------------------------------------------------------
-- | Splices an array. See [splice](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Array/splice).
splice :: ToJSVal value => Int -> Int -> [value] -> Array value -> IO (Array value)
splice :: forall value.
ToJSVal value =>
Int -> Int -> [value] -> Array value -> IO (Array value)
splice Int
start Int
deleteCount [value]
xs (Array JSVal
m) = do
  s <- Int -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
DSL.toJSVal Int
start
  d <- DSL.toJSVal deleteCount
  args <- mapM DSL.toJSVal xs
  Array <$> do callFunction m "splice" $ [s,d] ++ args
-----------------------------------------------------------------------------
-- | Construct a t'Array' from a list of value value pairs.
fromList :: ToJSVal value => [value] -> IO (Array value)
fromList :: forall value. ToJSVal value => [value] -> IO (Array value)
fromList [value]
xs = do
  m <- IO (Array value)
forall value. IO (Array value)
new
  forM_ (zip [0..] xs) $ \(Int
k,value
v) ->
    Int -> value -> Array value -> IO ()
forall value. ToJSVal value => Int -> value -> Array value -> IO ()
insert Int
k value
v Array value
m
  pure m
-----------------------------------------------------------------------------
-- | Converts an t'Array' to a list.
toList :: FromJSVal value => Array value -> IO [value]
toList :: forall value. FromJSVal value => Array value -> IO [value]
toList Array value
m = do
  len <- Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> IO Int -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array value -> IO Int
forall value. Array value -> IO Int
size Array value
m
  forM [0..len] (!? m)
-----------------------------------------------------------------------------
-- | Creates a new Array with a single element.
--
singleton :: ToJSVal a => a -> IO (Array a)
singleton :: forall a. ToJSVal a => a -> IO (Array a)
singleton a
x = [a] -> IO (Array a)
forall value. ToJSVal value => [value] -> IO (Array value)
fromList [a
x]
-----------------------------------------------------------------------------
-- | Removes the last element from an array and returns it.
--
-- Returns 'Nothing' if the t'Array' is empty.
--
pop :: FromJSVal a => Array a -> IO (Maybe a)
pop :: forall a. FromJSVal a => Array a -> IO (Maybe a)
pop (Array JSVal
arr) = JSVal -> IO (Maybe a)
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO (Maybe a)) -> IO JSVal -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> MisoString -> [JSVal] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
arr MisoString
"pop" ([] :: [JSVal])
-----------------------------------------------------------------------------
-- | Removes the first element from an array and returns it.
--
shift :: FromJSVal a => Array a -> IO (Maybe a)
shift :: forall a. FromJSVal a => Array a -> IO (Maybe a)
shift (Array JSVal
arr) = JSVal -> IO (Maybe a)
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO (Maybe a)) -> IO JSVal -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> MisoString -> [JSVal] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
arr MisoString
"shift" ([] :: [JSVal])
-----------------------------------------------------------------------------
-- | Adds one or more elements to the beginning of an array.
--
unshift :: ToJSVal a => a -> Array a -> IO Int
unshift :: forall a. ToJSVal a => a -> Array a -> IO Int
unshift a
x (Array JSVal
arr) = JSVal -> IO Int
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO Int) -> IO JSVal -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> MisoString -> [a] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
arr MisoString
"unshift" [a
x]
-----------------------------------------------------------------------------
-- | Reverses an array in-place.
--
reverse :: Array a -> IO ()
reverse :: forall a. Array a -> IO ()
reverse (Array JSVal
arr) = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ JSVal -> MisoString -> [JSVal] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
arr MisoString
"reverse" ([] :: [JSVal])
-----------------------------------------------------------------------------